Merge branch 'master' of git://git.savannah.gnu.org/guile into brainfuckbrainfuck

97 files changed, 14632 insertions, 324 deletions

diff --git a/HACKING b/HACKING
index f6d518531..ffe04a80d 100644
--- a/HACKING
+++ b/HACKING
@@ -59,8 +59,9 @@ Automake --- a system for automatically generating Makefiles that
 
 libtool --- a system for managing the zillion hairy options needed
 	on various systems to produce shared libraries.  Available in
-	"ftp://ftp.gnu.org/pub/gnu/libtool".  Version 1.5.26 (or
-	later) is needed for correct AIX support.
+	"ftp://ftp.gnu.org/pub/gnu/libtool".  Version 2.2 (or
+	later) is recommended (for correct AIX support, and correct
+	interaction with the Gnulib module for using libunistring).
 
 gettext --- a system for rigging a program so that it can output its
         messages in the local tongue.  Guile presently only exports
@@ -88,6 +89,10 @@ have been known to cause problems, and a short description of the problem.
 - autoreconf from autoconf prior to 2.59 will run gettextize, which
   will mess up the Guile tree.
 
+- libtool 1.5.26 does not know that it should remove the -R options
+  that the Gnulib libunistring and havelib modules generate (because
+  gcc doesn't actually support -R).
+
 - (add here.)
 
 
diff --git a/NEWS b/NEWS
index 1785fe8d2..9aca5d912 100644
--- a/NEWS
+++ b/NEWS
@@ -50,6 +50,10 @@ simplifies code and reduces both the storage and run-time overhead.
 
 Changes in 1.8.7 (since 1.8.6)
 
+* New modules (see the manual for details)
+
+** `(srfi srfi-98)', an interface to access environment variables
+
 * Bugs fixed
 
 ** Fix compilation with `--disable-deprecated'
diff --git a/README b/README
index 9993fcfaf..4950229df 100644
--- a/README
+++ b/README
@@ -61,6 +61,12 @@ Guile requires the following external packages:
     libltdl is used for loading extensions at run-time.  It is
     available from http://www.gnu.org/software/libtool/
 
+  - GNU libunistring
+
+    libunistring is used for Unicode string operations, such as the
+    `utf*->string' procedures.  It is available from
+    http://www.gnu.org/software/libunistring/ .
+
 
 Special Instructions For Some Systems =====================================
 
diff --git a/THANKS b/THANKS
index c347abc73..e3cf1e37c 100644
--- a/THANKS
+++ b/THANKS
@@ -37,6 +37,7 @@ For fixes or providing information which led to a fix:
          John W Eaton
 	Clinton Ebadi
           David Fang
+          Barry Fishman
         Charles Gagnon
           Peter Gavin
            Eric Gillespie, Jr
diff --git a/am/guilec b/am/guilec
index f8690d305..ce0711b74 100644
--- a/am/guilec
+++ b/am/guilec
@@ -2,12 +2,32 @@
 GOBJECTS = $(SOURCES:%.scm=%.go)
 
 moddir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/$(modpath)
-nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) $(GOBJECTS)
+nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
+ccachedir = $(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/ccache/$(modpath)
+nobase_ccache_DATA = $(GOBJECTS)
 EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
 
 CLEANFILES = $(GOBJECTS)
 
+# Well, shit. We can't have install changing timestamps, can we? But
+# install_sh doesn't know how to preserve timestamps. Soooo, fondle
+# automake to make things happen.
+install-data-hook:
+	@$(am__vpath_adj_setup) \
+	list='$(nobase_mod_DATA)'; for p in $$list; do \
+	  if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+	  $(am__vpath_adj) \
+	  echo " touch -r '$$d$$p' '$(DESTDIR)$(moddir)/$$f'"; \
+	  touch -r "$$d$$p" "$(DESTDIR)$(moddir)/$$f"; \
+	done
+	@$(am__vpath_adj_setup) \
+	list='$(nobase_ccache_DATA)'; for p in $$list; do \
+	  if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+	  $(am__vpath_adj) \
+	  echo " touch -r '$$d$$p' '$(DESTDIR)$(ccachedir)/$$f'"; \
+	  touch -r "$$d$$p" "$(DESTDIR)$(ccachedir)/$$f"; \
+	done
+
 SUFFIXES = .scm .go
 .scm.go:
-	$(MKDIR_P) `dirname $@`
-	$(top_builddir)/meta/uninstalled-env guile-tools compile -o "$@" "$<"
+	GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/uninstalled-env guile-tools compile -o "$@" "$<"
diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index e65e8bcb2..dcadd5869 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -1,4 +1,5 @@
 SCM_BENCHMARKS = benchmarks/0-reference.bm		\
+		 benchmarks/bytevectors.bm		\
 	         benchmarks/continuations.bm		\
                  benchmarks/if.bm			\
                  benchmarks/logand.bm			\
diff --git a/benchmark-suite/benchmarks/bytevectors.bm b/benchmark-suite/benchmarks/bytevectors.bm
new file mode 100644
index 000000000..9547a71df
--- /dev/null
+++ b/benchmark-suite/benchmarks/bytevectors.bm
@@ -0,0 +1,99 @@
+;;; -*- mode: scheme; coding: latin-1; -*-
+;;; R6RS Byte Vectors.
+;;;
+;;; Copyright 2009  Ludovic Courtès <ludo@gnu.org>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+(define-module (benchmarks bytevector)
+  :use-module (rnrs bytevector)
+  :use-module (srfi srfi-4)
+  :use-module (benchmark-suite lib))
+
+(define bv (make-bytevector 16384))
+
+(define %native-endianness
+  (native-endianness))
+
+(define %foreign-endianness
+  (if (eq? (native-endianness) (endianness little))
+      (endianness big)
+      (endianness little)))
+
+(define u8v  (make-u8vector 16384))
+(define u16v (make-u16vector 8192))
+(define u32v (make-u32vector 4196))
+(define u64v (make-u64vector 2048))
+
+
+(with-benchmark-prefix "ref/set!"
+
+  (benchmark "bytevector-u8-ref" 1000000
+    (bytevector-u8-ref bv 0))
+
+  (benchmark "bytevector-u16-ref (foreign)" 1000000
+    (bytevector-u16-ref bv 0 %foreign-endianness))
+
+  (benchmark "bytevector-u16-ref (native)" 1000000
+    (bytevector-u16-ref bv 0 %native-endianness))
+
+  (benchmark "bytevector-u16-native-ref" 1000000
+    (bytevector-u16-native-ref bv 0))
+
+  (benchmark "bytevector-u32-ref (foreign)" 1000000
+    (bytevector-u32-ref bv 0 %foreign-endianness))
+
+  (benchmark "bytevector-u32-ref (native)" 1000000
+    (bytevector-u32-ref bv 0 %native-endianness))
+
+  (benchmark "bytevector-u32-native-ref" 1000000
+    (bytevector-u32-native-ref bv 0))
+
+  (benchmark "bytevector-u64-ref (foreign)" 1000000
+    (bytevector-u64-ref bv 0 %foreign-endianness))
+
+  (benchmark "bytevector-u64-ref (native)" 1000000
+    (bytevector-u64-ref bv 0 %native-endianness))
+
+  (benchmark "bytevector-u64-native-ref" 1000000
+    (bytevector-u16-native-ref bv 0)))
+
+
+(with-benchmark-prefix "lists"
+
+  (benchmark "bytevector->u8-list" 2000
+    (bytevector->u8-list bv))
+
+  (benchmark "bytevector->uint-list 16-bit" 2000
+    (bytevector->uint-list bv (native-endianness) 2))
+
+  (benchmark "bytevector->uint-list 64-bit" 2000
+    (bytevector->uint-list bv (native-endianness) 8)))
+
+
+(with-benchmark-prefix "SRFI-4" ;; for comparison
+
+  (benchmark "u8vector-ref" 1000000
+    (u8vector-ref u8v 0))
+
+  (benchmark "u16vector-ref" 1000000
+    (u16vector-ref u16v 0))
+
+  (benchmark "u32vector-ref" 1000000
+    (u32vector-ref u32v 0))
+
+  (benchmark "u64vector-ref" 1000000
+    (u64vector-ref u64v 0)))
diff --git a/build-aux/config.rpath b/build-aux/config.rpath
index 35f959b87..85c2f209b 100755
--- a/build-aux/config.rpath
+++ b/build-aux/config.rpath
@@ -47,7 +47,7 @@ for cc_temp in $CC""; do
 done
 cc_basename=`echo "$cc_temp" | sed -e 's%^.*/%%'`
 
-# Code taken from libtool.m4's AC_LIBTOOL_PROG_COMPILER_PIC.
+# Code taken from libtool.m4's _LT_COMPILER_PIC.
 
 wl=
 if test "$GCC" = yes; then
@@ -64,7 +64,7 @@ else
           ;;
       esac
       ;;
-    mingw* | cygwin* | pw32* | os2*)
+    mingw* | cygwin* | pw32* | os2* | cegcc*)
       ;;
     hpux9* | hpux10* | hpux11*)
       wl='-Wl,'
@@ -76,7 +76,13 @@ else
       ;;
     linux* | k*bsd*-gnu)
       case $cc_basename in
-        icc* | ecc*)
+        ecc*)
+          wl='-Wl,'
+          ;;
+        icc* | ifort*)
+          wl='-Wl,'
+          ;;
+        lf95*)
           wl='-Wl,'
           ;;
         pgcc | pgf77 | pgf90)
@@ -124,7 +130,7 @@ else
   esac
 fi
 
-# Code taken from libtool.m4's AC_LIBTOOL_PROG_LD_SHLIBS.
+# Code taken from libtool.m4's _LT_LINKER_SHLIBS.
 
 hardcode_libdir_flag_spec=
 hardcode_libdir_separator=
@@ -132,7 +138,7 @@ hardcode_direct=no
 hardcode_minus_L=no
 
 case "$host_os" in
-  cygwin* | mingw* | pw32*)
+  cygwin* | mingw* | pw32* | cegcc*)
     # FIXME: the MSVC++ port hasn't been tested in a loooong time
     # When not using gcc, we currently assume that we are using
     # Microsoft Visual C++.
@@ -182,7 +188,7 @@ if test "$with_gnu_ld" = yes; then
         ld_shlibs=no
       fi
       ;;
-    cygwin* | mingw* | pw32*)
+    cygwin* | mingw* | pw32* | cegcc*)
       # hardcode_libdir_flag_spec is actually meaningless, as there is
       # no search path for DLLs.
       hardcode_libdir_flag_spec='-L$libdir'
@@ -326,7 +332,7 @@ else
       ;;
     bsdi[45]*)
       ;;
-    cygwin* | mingw* | pw32*)
+    cygwin* | mingw* | pw32* | cegcc*)
       # When not using gcc, we currently assume that we are using
       # Microsoft Visual C++.
       # hardcode_libdir_flag_spec is actually meaningless, as there is
@@ -494,7 +500,7 @@ else
 fi
 
 # Check dynamic linker characteristics
-# Code taken from libtool.m4's AC_LIBTOOL_SYS_DYNAMIC_LINKER.
+# Code taken from libtool.m4's _LT_SYS_DYNAMIC_LINKER.
 # Unlike libtool.m4, here we don't care about _all_ names of the library, but
 # only about the one the linker finds when passed -lNAME. This is the last
 # element of library_names_spec in libtool.m4, or possibly two of them if the
@@ -517,7 +523,7 @@ case "$host_os" in
   bsdi[45]*)
     library_names_spec='$libname$shrext'
     ;;
-  cygwin* | mingw* | pw32*)
+  cygwin* | mingw* | pw32* | cegcc*)
     shrext=.dll
     library_names_spec='$libname.dll.a $libname.lib'
     ;;
diff --git a/configure.in b/configure.in
index 07c476686..6568e524f 100644
--- a/configure.in
+++ b/configure.in
@@ -836,6 +836,13 @@ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <gmp.h>]],
   [],
   [AC_MSG_ERROR([At least GNU MP 4.1 is required, see README])])
 
+dnl GNU libunistring tests.
+if test "x$LTLIBUNISTRING" != "x"; then
+   LIBS="$LTLIBUNISTRING $LIBS"
+else
+   AC_MSG_ERROR([GNU libunistring is required, please install it.])
+fi
+
 dnl i18n tests
 #AC_CHECK_HEADERS([libintl.h])
 #AC_CHECK_FUNCS(gettext)
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 1fa50b209..7c107e710 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -47,6 +47,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-61::                     A more general `cond' clause
 * SRFI-69::                     Basic hash tables.
 * SRFI-88::                     Keyword objects.
+* SRFI-98::                     Accessing environment variables.
 @end menu
 
 
@@ -3608,6 +3609,25 @@ Return the keyword object whose name is @var{str}.
 @end example
 @end deffn
 
+@node SRFI-98
+@subsection SRFI-98 Accessing environment variables.
+@cindex SRFI-98
+@cindex environment variables
+
+This is a portable wrapper around Guile's built-in support for 
+interacting with the current environment, @xref{Runtime Environment}.
+
+@deffn {Scheme Procedure} get-environment-variable name
+Returns a string containing the value of the environment variable 
+given by the string @code{name}, or @code{#f} if the named 
+environment variable is not found.  This is equivalent to 
+@code{(getenv name)}.
+@end deffn
+
+@deffn {Scheme Procedure} get-environment-variables
+Returns the names and values of all the environment variables as an
+association list in which both the keys and the values are strings.
+@end deffn
 
 @c srfi-modules.texi ends here
 
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 49b420c50..8d7778c1c 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -417,6 +417,7 @@ external variables are all consed onto a list, which results in O(N)
 lookup time.
 
 @deffn Instruction toplevel-ref index
+@deffnx Instruction long-toplevel-ref index
 Push the value of the toplevel binding whose location is stored in at
 position @var{index} in the object table.
 
@@ -441,14 +442,19 @@ in-place mutation of the object table. This mechanism provides for
 lazy variable resolution, and an important cached fast-path once the
 variable has been successfully resolved.
 
+The ``long'' variant has a 16-bit index instead of an 8-bit index,
+with the most significant byte first.
+
 This instruction pushes the value of the variable onto the stack.
 @end deffn
 
-@deffn Instruction toplevel-ref index
+@deffn Instruction toplevel-set index
+@deffnx Instruction long-toplevel-set index
 Pop a value off the stack, and set it as the value of the toplevel
 variable stored at @var{index} in the object table. If the variable
 has not yet been looked up, we do the lookup as in
-@code{toplevel-ref}.
+@code{toplevel-ref}. The ``long'' variant has a 16-bit index instead
+of an 8-bit index.
 @end deffn
 
 @deffn Instruction link-now
@@ -471,7 +477,9 @@ the variable to the value.
 @end deffn
 
 @deffn Instruction object-ref n
-Push @var{n}th value from the current program's object vector.
+@deffnx Instruction long-object-ref n
+Push @var{n}th value from the current program's object vector. The
+``long'' variant has a 16-bit index instead of an 8-bit index.
 @end deffn
 
 @node Branch Instructions
diff --git a/lib/Makefile.am b/lib/Makefile.am
index f321b0b16..6f2f5c5fa 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -9,9 +9,9 @@
 # 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 --libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild count-one-bits environ extensions flock fpieee full-read full-write lib-symbol-visibility putenv stdlib strcase strftime
+# 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 --libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild byteswap count-one-bits environ extensions flock fpieee full-read full-write iconv_open-utf lib-symbol-visibility libunistring putenv stdlib strcase strftime striconveh string
 
-AUTOMAKE_OPTIONS = 1.5 gnits
+AUTOMAKE_OPTIONS = 1.5 gnits subdir-objects
 
 SUBDIRS =
 noinst_HEADERS =
@@ -54,6 +54,42 @@ EXTRA_DIST += alloca.in.h
 
 ## end   gnulib module alloca-opt
 
+## begin gnulib module byteswap
+
+BUILT_SOURCES += $(BYTESWAP_H)
+
+# We need the following in order to create <byteswap.h> when the system
+# doesn't have one.
+byteswap.h: byteswap.in.h
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+	  cat $(srcdir)/byteswap.in.h; \
+	} > $@-t
+	mv -f $@-t $@
+MOSTLYCLEANFILES += byteswap.h byteswap.h-t
+
+EXTRA_DIST += byteswap.in.h
+
+## end   gnulib module byteswap
+
+## begin gnulib module c-ctype
+
+libgnu_la_SOURCES += c-ctype.h c-ctype.c
+
+## end   gnulib module c-ctype
+
+## begin gnulib module c-strcase
+
+libgnu_la_SOURCES += c-strcase.h c-strcasecmp.c c-strncasecmp.c
+
+## end   gnulib module c-strcase
+
+## begin gnulib module c-strcaseeq
+
+
+EXTRA_DIST += c-strcaseeq.h
+
+## end   gnulib module c-strcaseeq
+
 ## begin gnulib module configmake
 
 # Retrieve values of the variables through 'configure' followed by
@@ -143,6 +179,72 @@ libgnu_la_SOURCES += full-write.h full-write.c
 
 ## end   gnulib module full-write
 
+## begin gnulib module gperf
+
+GPERF = gperf
+
+## end   gnulib module gperf
+
+## begin gnulib module havelib
+
+
+EXTRA_DIST += $(top_srcdir)/build-aux/config.rpath
+
+## end   gnulib module havelib
+
+## begin gnulib module iconv_open
+
+BUILT_SOURCES += $(ICONV_H)
+
+# We need the following in order to create <iconv.h> when the system
+# doesn't have one that works with the given compiler.
+iconv.h: iconv.in.h
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
+	  sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+	      -e 's|@''NEXT_ICONV_H''@|$(NEXT_ICONV_H)|g' \
+	      -e 's|@''ICONV_CONST''@|$(ICONV_CONST)|g' \
+	      -e 's|@''REPLACE_ICONV''@|$(REPLACE_ICONV)|g' \
+	      -e 's|@''REPLACE_ICONV_OPEN''@|$(REPLACE_ICONV_OPEN)|g' \
+	      -e 's|@''REPLACE_ICONV_UTF''@|$(REPLACE_ICONV_UTF)|g' \
+	      < $(srcdir)/iconv.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += iconv.h iconv.h-t
+
+iconv_open-aix.h: iconv_open-aix.gperf
+	$(GPERF) -m 10 $(srcdir)/iconv_open-aix.gperf > $(srcdir)/iconv_open-aix.h-t
+	mv $(srcdir)/iconv_open-aix.h-t $(srcdir)/iconv_open-aix.h
+iconv_open-hpux.h: iconv_open-hpux.gperf
+	$(GPERF) -m 10 $(srcdir)/iconv_open-hpux.gperf > $(srcdir)/iconv_open-hpux.h-t
+	mv $(srcdir)/iconv_open-hpux.h-t $(srcdir)/iconv_open-hpux.h
+iconv_open-irix.h: iconv_open-irix.gperf
+	$(GPERF) -m 10 $(srcdir)/iconv_open-irix.gperf > $(srcdir)/iconv_open-irix.h-t
+	mv $(srcdir)/iconv_open-irix.h-t $(srcdir)/iconv_open-irix.h
+iconv_open-osf.h: iconv_open-osf.gperf
+	$(GPERF) -m 10 $(srcdir)/iconv_open-osf.gperf > $(srcdir)/iconv_open-osf.h-t
+	mv $(srcdir)/iconv_open-osf.h-t $(srcdir)/iconv_open-osf.h
+BUILT_SOURCES        += iconv_open-aix.h iconv_open-hpux.h iconv_open-irix.h iconv_open-osf.h
+MOSTLYCLEANFILES     += iconv_open-aix.h-t iconv_open-hpux.h-t iconv_open-irix.h-t iconv_open-osf.h-t
+MAINTAINERCLEANFILES += iconv_open-aix.h iconv_open-hpux.h iconv_open-irix.h iconv_open-osf.h
+EXTRA_DIST           += iconv_open-aix.h iconv_open-hpux.h iconv_open-irix.h iconv_open-osf.h
+
+EXTRA_DIST += iconv.in.h iconv_open-aix.gperf iconv_open-hpux.gperf iconv_open-irix.gperf iconv_open-osf.gperf iconv_open.c
+
+EXTRA_libgnu_la_SOURCES += iconv_open.c
+
+## end   gnulib module iconv_open
+
+## begin gnulib module iconv_open-utf
+
+
+EXTRA_DIST += iconv.c iconv_close.c
+
+EXTRA_libgnu_la_SOURCES += iconv.c iconv_close.c
+
+## end   gnulib module iconv_open-utf
+
 ## begin gnulib module lib-symbol-visibility
 
 # The value of $(CFLAG_VISIBILITY) needs to be added to the CFLAGS for the
@@ -442,6 +544,95 @@ EXTRA_libgnu_la_SOURCES += strftime.c
 
 ## end   gnulib module strftime
 
+## begin gnulib module striconveh
+
+libgnu_la_SOURCES += striconveh.h striconveh.c
+if GL_COND_LIBTOOL
+libgnu_la_LDFLAGS += $(LTLIBICONV)
+endif
+
+EXTRA_DIST += iconveh.h
+
+## end   gnulib module striconveh
+
+## begin gnulib module string
+
+BUILT_SOURCES += string.h
+
+# We need the following in order to create <string.h> when the system
+# doesn't have one that works with the given compiler.
+string.h: string.in.h
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
+	  sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+	      -e 's|@''NEXT_STRING_H''@|$(NEXT_STRING_H)|g' \
+	      -e 's|@''GNULIB_MBSLEN''@|$(GNULIB_MBSLEN)|g' \
+	      -e 's|@''GNULIB_MBSNLEN''@|$(GNULIB_MBSNLEN)|g' \
+	      -e 's|@''GNULIB_MBSCHR''@|$(GNULIB_MBSCHR)|g' \
+	      -e 's|@''GNULIB_MBSRCHR''@|$(GNULIB_MBSRCHR)|g' \
+	      -e 's|@''GNULIB_MBSSTR''@|$(GNULIB_MBSSTR)|g' \
+	      -e 's|@''GNULIB_MBSCASECMP''@|$(GNULIB_MBSCASECMP)|g' \
+	      -e 's|@''GNULIB_MBSNCASECMP''@|$(GNULIB_MBSNCASECMP)|g' \
+	      -e 's|@''GNULIB_MBSPCASECMP''@|$(GNULIB_MBSPCASECMP)|g' \
+	      -e 's|@''GNULIB_MBSCASESTR''@|$(GNULIB_MBSCASESTR)|g' \
+	      -e 's|@''GNULIB_MBSCSPN''@|$(GNULIB_MBSCSPN)|g' \
+	      -e 's|@''GNULIB_MBSPBRK''@|$(GNULIB_MBSPBRK)|g' \
+	      -e 's|@''GNULIB_MBSSPN''@|$(GNULIB_MBSSPN)|g' \
+	      -e 's|@''GNULIB_MBSSEP''@|$(GNULIB_MBSSEP)|g' \
+	      -e 's|@''GNULIB_MBSTOK_R''@|$(GNULIB_MBSTOK_R)|g' \
+	      -e 's|@''GNULIB_MEMMEM''@|$(GNULIB_MEMMEM)|g' \
+	      -e 's|@''GNULIB_MEMPCPY''@|$(GNULIB_MEMPCPY)|g' \
+	      -e 's|@''GNULIB_MEMRCHR''@|$(GNULIB_MEMRCHR)|g' \
+	      -e 's|@''GNULIB_RAWMEMCHR''@|$(GNULIB_RAWMEMCHR)|g' \
+	      -e 's|@''GNULIB_STPCPY''@|$(GNULIB_STPCPY)|g' \
+	      -e 's|@''GNULIB_STPNCPY''@|$(GNULIB_STPNCPY)|g' \
+	      -e 's|@''GNULIB_STRCHRNUL''@|$(GNULIB_STRCHRNUL)|g' \
+	      -e 's|@''GNULIB_STRDUP''@|$(GNULIB_STRDUP)|g' \
+	      -e 's|@''GNULIB_STRNDUP''@|$(GNULIB_STRNDUP)|g' \
+	      -e 's|@''GNULIB_STRNLEN''@|$(GNULIB_STRNLEN)|g' \
+	      -e 's|@''GNULIB_STRPBRK''@|$(GNULIB_STRPBRK)|g' \
+	      -e 's|@''GNULIB_STRSEP''@|$(GNULIB_STRSEP)|g' \
+	      -e 's|@''GNULIB_STRSTR''@|$(GNULIB_STRSTR)|g' \
+	      -e 's|@''GNULIB_STRCASESTR''@|$(GNULIB_STRCASESTR)|g' \
+	      -e 's|@''GNULIB_STRTOK_R''@|$(GNULIB_STRTOK_R)|g' \
+	      -e 's|@''GNULIB_STRERROR''@|$(GNULIB_STRERROR)|g' \
+	      -e 's|@''GNULIB_STRSIGNAL''@|$(GNULIB_STRSIGNAL)|g' \
+	      -e 's|@''GNULIB_STRVERSCMP''@|$(GNULIB_STRVERSCMP)|g' \
+	      -e 's|@''HAVE_DECL_MEMMEM''@|$(HAVE_DECL_MEMMEM)|g' \
+	      -e 's|@''HAVE_MEMPCPY''@|$(HAVE_MEMPCPY)|g' \
+	      -e 's|@''HAVE_DECL_MEMRCHR''@|$(HAVE_DECL_MEMRCHR)|g' \
+	      -e 's|@''HAVE_RAWMEMCHR''@|$(HAVE_RAWMEMCHR)|g' \
+	      -e 's|@''HAVE_STPCPY''@|$(HAVE_STPCPY)|g' \
+	      -e 's|@''HAVE_STPNCPY''@|$(HAVE_STPNCPY)|g' \
+	      -e 's|@''HAVE_STRCHRNUL''@|$(HAVE_STRCHRNUL)|g' \
+	      -e 's|@''HAVE_DECL_STRDUP''@|$(HAVE_DECL_STRDUP)|g' \
+	      -e 's|@''HAVE_STRNDUP''@|$(HAVE_STRNDUP)|g' \
+	      -e 's|@''HAVE_DECL_STRNDUP''@|$(HAVE_DECL_STRNDUP)|g' \
+	      -e 's|@''HAVE_DECL_STRNLEN''@|$(HAVE_DECL_STRNLEN)|g' \
+	      -e 's|@''HAVE_STRPBRK''@|$(HAVE_STRPBRK)|g' \
+	      -e 's|@''HAVE_STRSEP''@|$(HAVE_STRSEP)|g' \
+	      -e 's|@''HAVE_STRCASESTR''@|$(HAVE_STRCASESTR)|g' \
+	      -e 's|@''HAVE_DECL_STRTOK_R''@|$(HAVE_DECL_STRTOK_R)|g' \
+	      -e 's|@''HAVE_DECL_STRERROR''@|$(HAVE_DECL_STRERROR)|g' \
+	      -e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \
+	      -e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \
+	      -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \
+	      -e 's|@''REPLACE_STRCASESTR''@|$(REPLACE_STRCASESTR)|g' \
+	      -e 's|@''REPLACE_STRDUP''@|$(REPLACE_STRDUP)|g' \
+	      -e 's|@''REPLACE_STRSTR''@|$(REPLACE_STRSTR)|g' \
+	      -e 's|@''REPLACE_STRERROR''@|$(REPLACE_STRERROR)|g' \
+	      -e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \
+	      -e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \
+	      < $(srcdir)/string.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += string.h string.h-t
+
+EXTRA_DIST += string.in.h
+
+## end   gnulib module string
+
 ## begin gnulib module strings
 
 BUILT_SOURCES += strings.h
@@ -598,6 +789,50 @@ EXTRA_DIST += unistd.in.h
 
 ## end   gnulib module unistd
 
+## begin gnulib module unistr/base
+
+
+EXTRA_DIST += unistr.h
+
+## end   gnulib module unistr/base
+
+## begin gnulib module unistr/u8-mbtouc
+
+libgnu_la_SOURCES += unistr/u8-mbtouc.c unistr/u8-mbtouc-aux.c
+
+## end   gnulib module unistr/u8-mbtouc
+
+## begin gnulib module unistr/u8-mbtouc-unsafe
+
+libgnu_la_SOURCES += unistr/u8-mbtouc-unsafe.c unistr/u8-mbtouc-unsafe-aux.c
+
+## end   gnulib module unistr/u8-mbtouc-unsafe
+
+## begin gnulib module unistr/u8-mbtoucr
+
+libgnu_la_SOURCES += unistr/u8-mbtoucr.c
+
+## end   gnulib module unistr/u8-mbtoucr
+
+## begin gnulib module unistr/u8-prev
+
+libgnu_la_SOURCES += unistr/u8-prev.c
+
+## end   gnulib module unistr/u8-prev
+
+## begin gnulib module unistr/u8-uctomb
+
+libgnu_la_SOURCES += unistr/u8-uctomb.c unistr/u8-uctomb-aux.c
+
+## end   gnulib module unistr/u8-uctomb
+
+## begin gnulib module unitypes
+
+
+EXTRA_DIST += unitypes.h
+
+## end   gnulib module unitypes
+
 ## begin gnulib module verify
 
 libgnu_la_SOURCES += verify.h
diff --git a/lib/byteswap.in.h b/lib/byteswap.in.h
new file mode 100644
index 000000000..f03463db6
--- /dev/null
+++ b/lib/byteswap.in.h
@@ -0,0 +1,44 @@
+/* byteswap.h - Byte swapping
+   Copyright (C) 2005, 2007 Free Software Foundation, Inc.
+   Written by Oskar Liljeblad <oskar@osk.mine.nu>, 2005.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _GL_BYTESWAP_H
+#define _GL_BYTESWAP_H
+
+/* Given an unsigned 16-bit argument X, return the value corresponding to
+   X with reversed byte order.  */
+#define bswap_16(x) ((((x) & 0x00FF) << 8) | \
+		     (((x) & 0xFF00) >> 8))
+
+/* Given an unsigned 32-bit argument X, return the value corresponding to
+   X with reversed byte order.  */
+#define bswap_32(x) ((((x) & 0x000000FF) << 24) | \
+		     (((x) & 0x0000FF00) << 8) | \
+		     (((x) & 0x00FF0000) >> 8) | \
+		     (((x) & 0xFF000000) >> 24))
+
+/* Given an unsigned 64-bit argument X, return the value corresponding to
+   X with reversed byte order.  */
+#define bswap_64(x) ((((x) & 0x00000000000000FFULL) << 56) | \
+		     (((x) & 0x000000000000FF00ULL) << 40) | \
+		     (((x) & 0x0000000000FF0000ULL) << 24) | \
+		     (((x) & 0x00000000FF000000ULL) << 8) | \
+		     (((x) & 0x000000FF00000000ULL) >> 8) | \
+		     (((x) & 0x0000FF0000000000ULL) >> 24) | \
+		     (((x) & 0x00FF000000000000ULL) >> 40) | \
+		     (((x) & 0xFF00000000000000ULL) >> 56))
+
+#endif /* _GL_BYTESWAP_H */
diff --git a/lib/c-ctype.c b/lib/c-ctype.c
new file mode 100644
index 000000000..e36a51340
--- /dev/null
+++ b/lib/c-ctype.c
@@ -0,0 +1,396 @@
+/* Character handling in C locale.
+
+   Copyright 2000-2003, 2006 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 2 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, write to the Free Software Foundation,
+Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#define NO_C_CTYPE_MACROS
+#include "c-ctype.h"
+
+/* The function isascii is not locale dependent. Its use in EBCDIC is
+   questionable. */
+bool
+c_isascii (int c)
+{
+  return (c >= 0x00 && c <= 0x7f);
+}
+
+bool
+c_isalnum (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+    && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+  return ((c >= '0' && c <= '9')
+          || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z'));
+#else
+  return ((c >= '0' && c <= '9')
+          || (c >= 'A' && c <= 'Z')
+          || (c >= 'a' && c <= 'z'));
+#endif
+#else
+  switch (c)
+    {
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isalpha (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+  return ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z');
+#else
+  return ((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z'));
+#endif
+#else
+  switch (c)
+    {
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isblank (int c)
+{
+  return (c == ' ' || c == '\t');
+}
+
+bool
+c_iscntrl (int c)
+{
+#if C_CTYPE_ASCII
+  return ((c & ~0x1f) == 0 || c == 0x7f);
+#else
+  switch (c)
+    {
+    case ' ': case '!': case '"': case '#': case '$': case '%':
+    case '&': case '\'': case '(': case ')': case '*': case '+':
+    case ',': case '-': case '.': case '/':
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+    case ':': case ';': case '<': case '=': case '>': case '?':
+    case '@':
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+    case '[': case '\\': case ']': case '^': case '_': case '`':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+    case '{': case '|': case '}': case '~':
+      return 0;
+    default:
+      return 1;
+    }
+#endif
+}
+
+bool
+c_isdigit (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS
+  return (c >= '0' && c <= '9');
+#else
+  switch (c)
+    {
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_islower (int c)
+{
+#if C_CTYPE_CONSECUTIVE_LOWERCASE
+  return (c >= 'a' && c <= 'z');
+#else
+  switch (c)
+    {
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isgraph (int c)
+{
+#if C_CTYPE_ASCII
+  return (c >= '!' && c <= '~');
+#else
+  switch (c)
+    {
+    case '!': case '"': case '#': case '$': case '%': case '&':
+    case '\'': case '(': case ')': case '*': case '+': case ',':
+    case '-': case '.': case '/':
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+    case ':': case ';': case '<': case '=': case '>': case '?':
+    case '@':
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+    case '[': case '\\': case ']': case '^': case '_': case '`':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+    case '{': case '|': case '}': case '~':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isprint (int c)
+{
+#if C_CTYPE_ASCII
+  return (c >= ' ' && c <= '~');
+#else
+  switch (c)
+    {
+    case ' ': case '!': case '"': case '#': case '$': case '%':
+    case '&': case '\'': case '(': case ')': case '*': case '+':
+    case ',': case '-': case '.': case '/':
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+    case ':': case ';': case '<': case '=': case '>': case '?':
+    case '@':
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+    case '[': case '\\': case ']': case '^': case '_': case '`':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+    case '{': case '|': case '}': case '~':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_ispunct (int c)
+{
+#if C_CTYPE_ASCII
+  return ((c >= '!' && c <= '~')
+          && !((c >= '0' && c <= '9')
+               || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z')));
+#else
+  switch (c)
+    {
+    case '!': case '"': case '#': case '$': case '%': case '&':
+    case '\'': case '(': case ')': case '*': case '+': case ',':
+    case '-': case '.': case '/':
+    case ':': case ';': case '<': case '=': case '>': case '?':
+    case '@':
+    case '[': case '\\': case ']': case '^': case '_': case '`':
+    case '{': case '|': case '}': case '~':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isspace (int c)
+{
+  return (c == ' ' || c == '\t'
+          || c == '\n' || c == '\v' || c == '\f' || c == '\r');
+}
+
+bool
+c_isupper (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE
+  return (c >= 'A' && c <= 'Z');
+#else
+  switch (c)
+    {
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isxdigit (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+    && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+  return ((c >= '0' && c <= '9')
+          || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'F'));
+#else
+  return ((c >= '0' && c <= '9')
+          || (c >= 'A' && c <= 'F')
+          || (c >= 'a' && c <= 'f'));
+#endif
+#else
+  switch (c)
+    {
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+int
+c_tolower (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+  return (c >= 'A' && c <= 'Z' ? c - 'A' + 'a' : c);
+#else
+  switch (c)
+    {
+    case 'A': return 'a';
+    case 'B': return 'b';
+    case 'C': return 'c';
+    case 'D': return 'd';
+    case 'E': return 'e';
+    case 'F': return 'f';
+    case 'G': return 'g';
+    case 'H': return 'h';
+    case 'I': return 'i';
+    case 'J': return 'j';
+    case 'K': return 'k';
+    case 'L': return 'l';
+    case 'M': return 'm';
+    case 'N': return 'n';
+    case 'O': return 'o';
+    case 'P': return 'p';
+    case 'Q': return 'q';
+    case 'R': return 'r';
+    case 'S': return 's';
+    case 'T': return 't';
+    case 'U': return 'u';
+    case 'V': return 'v';
+    case 'W': return 'w';
+    case 'X': return 'x';
+    case 'Y': return 'y';
+    case 'Z': return 'z';
+    default: return c;
+    }
+#endif
+}
+
+int
+c_toupper (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+  return (c >= 'a' && c <= 'z' ? c - 'a' + 'A' : c);
+#else
+  switch (c)
+    {
+    case 'a': return 'A';
+    case 'b': return 'B';
+    case 'c': return 'C';
+    case 'd': return 'D';
+    case 'e': return 'E';
+    case 'f': return 'F';
+    case 'g': return 'G';
+    case 'h': return 'H';
+    case 'i': return 'I';
+    case 'j': return 'J';
+    case 'k': return 'K';
+    case 'l': return 'L';
+    case 'm': return 'M';
+    case 'n': return 'N';
+    case 'o': return 'O';
+    case 'p': return 'P';
+    case 'q': return 'Q';
+    case 'r': return 'R';
+    case 's': return 'S';
+    case 't': return 'T';
+    case 'u': return 'U';
+    case 'v': return 'V';
+    case 'w': return 'W';
+    case 'x': return 'X';
+    case 'y': return 'Y';
+    case 'z': return 'Z';
+    default: return c;
+    }
+#endif
+}
diff --git a/lib/c-ctype.h b/lib/c-ctype.h
new file mode 100644
index 000000000..d7b067e83
--- /dev/null
+++ b/lib/c-ctype.h
@@ -0,0 +1,295 @@
+/* Character handling in C locale.
+
+   These functions work like the corresponding functions in <ctype.h>,
+   except that they have the C (POSIX) locale hardwired, whereas the
+   <ctype.h> functions' behaviour depends on the current locale set via
+   setlocale.
+
+   Copyright (C) 2000-2003, 2006, 2008 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 2 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, write to the Free Software Foundation,
+Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef C_CTYPE_H
+#define C_CTYPE_H
+
+#include <stdbool.h>
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* The functions defined in this file assume the "C" locale and a character
+   set without diacritics (ASCII-US or EBCDIC-US or something like that).
+   Even if the "C" locale on a particular system is an extension of the ASCII
+   character set (like on BeOS, where it is UTF-8, or on AmigaOS, where it
+   is ISO-8859-1), the functions in this file recognize only the ASCII
+   characters.  */
+
+
+/* Check whether the ASCII optimizations apply. */
+
+/* ANSI C89 (and ISO C99 5.2.1.3 too) already guarantees that
+   '0', '1', ..., '9' have consecutive integer values.  */
+#define C_CTYPE_CONSECUTIVE_DIGITS 1
+
+#if ('A' <= 'Z') \
+    && ('A' + 1 == 'B') && ('B' + 1 == 'C') && ('C' + 1 == 'D') \
+    && ('D' + 1 == 'E') && ('E' + 1 == 'F') && ('F' + 1 == 'G') \
+    && ('G' + 1 == 'H') && ('H' + 1 == 'I') && ('I' + 1 == 'J') \
+    && ('J' + 1 == 'K') && ('K' + 1 == 'L') && ('L' + 1 == 'M') \
+    && ('M' + 1 == 'N') && ('N' + 1 == 'O') && ('O' + 1 == 'P') \
+    && ('P' + 1 == 'Q') && ('Q' + 1 == 'R') && ('R' + 1 == 'S') \
+    && ('S' + 1 == 'T') && ('T' + 1 == 'U') && ('U' + 1 == 'V') \
+    && ('V' + 1 == 'W') && ('W' + 1 == 'X') && ('X' + 1 == 'Y') \
+    && ('Y' + 1 == 'Z')
+#define C_CTYPE_CONSECUTIVE_UPPERCASE 1
+#endif
+
+#if ('a' <= 'z') \
+    && ('a' + 1 == 'b') && ('b' + 1 == 'c') && ('c' + 1 == 'd') \
+    && ('d' + 1 == 'e') && ('e' + 1 == 'f') && ('f' + 1 == 'g') \
+    && ('g' + 1 == 'h') && ('h' + 1 == 'i') && ('i' + 1 == 'j') \
+    && ('j' + 1 == 'k') && ('k' + 1 == 'l') && ('l' + 1 == 'm') \
+    && ('m' + 1 == 'n') && ('n' + 1 == 'o') && ('o' + 1 == 'p') \
+    && ('p' + 1 == 'q') && ('q' + 1 == 'r') && ('r' + 1 == 's') \
+    && ('s' + 1 == 't') && ('t' + 1 == 'u') && ('u' + 1 == 'v') \
+    && ('v' + 1 == 'w') && ('w' + 1 == 'x') && ('x' + 1 == 'y') \
+    && ('y' + 1 == 'z')
+#define C_CTYPE_CONSECUTIVE_LOWERCASE 1
+#endif
+
+#if (' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+    && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+    && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+    && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+    && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+    && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+    && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+    && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+    && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+    && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+    && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+    && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+    && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+    && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+    && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+    && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+    && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+    && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+    && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+    && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+    && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+    && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+    && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126)
+/* The character set is ASCII or one of its variants or extensions, not EBCDIC.
+   Testing the value of '\n' and '\r' is not relevant.  */
+#define C_CTYPE_ASCII 1
+#endif
+
+
+/* Function declarations. */
+
+/* Unlike the functions in <ctype.h>, which require an argument in the range
+   of the 'unsigned char' type, the functions here operate on values that are
+   in the 'unsigned char' range or in the 'char' range.  In other words,
+   when you have a 'char' value, you need to cast it before using it as
+   argument to a <ctype.h> function:
+
+         const char *s = ...;
+         if (isalpha ((unsigned char) *s)) ...
+
+   but you don't need to cast it for the functions defined in this file:
+
+         const char *s = ...;
+         if (c_isalpha (*s)) ...
+ */
+
+extern bool c_isascii (int c); /* not locale dependent */
+
+extern bool c_isalnum (int c);
+extern bool c_isalpha (int c);
+extern bool c_isblank (int c);
+extern bool c_iscntrl (int c);
+extern bool c_isdigit (int c);
+extern bool c_islower (int c);
+extern bool c_isgraph (int c);
+extern bool c_isprint (int c);
+extern bool c_ispunct (int c);
+extern bool c_isspace (int c);
+extern bool c_isupper (int c);
+extern bool c_isxdigit (int c);
+
+extern int c_tolower (int c);
+extern int c_toupper (int c);
+
+
+#if defined __GNUC__ && defined __OPTIMIZE__ && !defined __OPTIMIZE_SIZE__ && !defined NO_C_CTYPE_MACROS
+
+/* ASCII optimizations. */
+
+#undef c_isascii
+#define c_isascii(c) \
+  ({ int __c = (c); \
+     (__c >= 0x00 && __c <= 0x7f); \
+   })
+
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+    && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isalnum
+#define c_isalnum(c) \
+  ({ int __c = (c); \
+     ((__c >= '0' && __c <= '9') \
+      || ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'Z')); \
+   })
+#else
+#undef c_isalnum
+#define c_isalnum(c) \
+  ({ int __c = (c); \
+     ((__c >= '0' && __c <= '9') \
+      || (__c >= 'A' && __c <= 'Z') \
+      || (__c >= 'a' && __c <= 'z')); \
+   })
+#endif
+#endif
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isalpha
+#define c_isalpha(c) \
+  ({ int __c = (c); \
+     ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'Z'); \
+   })
+#else
+#undef c_isalpha
+#define c_isalpha(c) \
+  ({ int __c = (c); \
+     ((__c >= 'A' && __c <= 'Z') || (__c >= 'a' && __c <= 'z')); \
+   })
+#endif
+#endif
+
+#undef c_isblank
+#define c_isblank(c) \
+  ({ int __c = (c); \
+     (__c == ' ' || __c == '\t'); \
+   })
+
+#if C_CTYPE_ASCII
+#undef c_iscntrl
+#define c_iscntrl(c) \
+  ({ int __c = (c); \
+     ((__c & ~0x1f) == 0 || __c == 0x7f); \
+   })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_DIGITS
+#undef c_isdigit
+#define c_isdigit(c) \
+  ({ int __c = (c); \
+     (__c >= '0' && __c <= '9'); \
+   })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_LOWERCASE
+#undef c_islower
+#define c_islower(c) \
+  ({ int __c = (c); \
+     (__c >= 'a' && __c <= 'z'); \
+   })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_isgraph
+#define c_isgraph(c) \
+  ({ int __c = (c); \
+     (__c >= '!' && __c <= '~'); \
+   })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_isprint
+#define c_isprint(c) \
+  ({ int __c = (c); \
+     (__c >= ' ' && __c <= '~'); \
+   })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_ispunct
+#define c_ispunct(c) \
+  ({ int _c = (c); \
+     (c_isgraph (_c) && ! c_isalnum (_c)); \
+   })
+#endif
+
+#undef c_isspace
+#define c_isspace(c) \
+  ({ int __c = (c); \
+     (__c == ' ' || __c == '\t' \
+      || __c == '\n' || __c == '\v' || __c == '\f' || __c == '\r'); \
+   })
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE
+#undef c_isupper
+#define c_isupper(c) \
+  ({ int __c = (c); \
+     (__c >= 'A' && __c <= 'Z'); \
+   })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+    && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isxdigit
+#define c_isxdigit(c) \
+  ({ int __c = (c); \
+     ((__c >= '0' && __c <= '9') \
+      || ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'F')); \
+   })
+#else
+#undef c_isxdigit
+#define c_isxdigit(c) \
+  ({ int __c = (c); \
+     ((__c >= '0' && __c <= '9') \
+      || (__c >= 'A' && __c <= 'F') \
+      || (__c >= 'a' && __c <= 'f')); \
+   })
+#endif
+#endif
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#undef c_tolower
+#define c_tolower(c) \
+  ({ int __c = (c); \
+     (__c >= 'A' && __c <= 'Z' ? __c - 'A' + 'a' : __c); \
+   })
+#undef c_toupper
+#define c_toupper(c) \
+  ({ int __c = (c); \
+     (__c >= 'a' && __c <= 'z' ? __c - 'a' + 'A' : __c); \
+   })
+#endif
+
+#endif /* optimizing for speed */
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* C_CTYPE_H */
diff --git a/lib/c-strcase.h b/lib/c-strcase.h
new file mode 100644
index 000000000..714a3c623
--- /dev/null
+++ b/lib/c-strcase.h
@@ -0,0 +1,55 @@
+/* Case-insensitive string comparison functions in C locale.
+   Copyright (C) 1995-1996, 2001, 2003, 2005 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 2, 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, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef C_STRCASE_H
+#define C_STRCASE_H
+
+#include <stddef.h>
+
+
+/* The functions defined in this file assume the "C" locale and a character
+   set without diacritics (ASCII-US or EBCDIC-US or something like that).
+   Even if the "C" locale on a particular system is an extension of the ASCII
+   character set (like on BeOS, where it is UTF-8, or on AmigaOS, where it
+   is ISO-8859-1), the functions in this file recognize only the ASCII
+   characters.  More precisely, one of the string arguments must be an ASCII
+   string; the other one can also contain non-ASCII characters (but then
+   the comparison result will be nonzero).  */
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Compare strings S1 and S2, ignoring case, returning less than, equal to or
+   greater than zero if S1 is lexicographically less than, equal to or greater
+   than S2.  */
+extern int c_strcasecmp (const char *s1, const char *s2);
+
+/* Compare no more than N characters of strings S1 and S2, ignoring case,
+   returning less than, equal to or greater than zero if S1 is
+   lexicographically less than, equal to or greater than S2.  */
+extern int c_strncasecmp (const char *s1, const char *s2, size_t n);
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* C_STRCASE_H */
diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c
new file mode 100644
index 000000000..a52389883
--- /dev/null
+++ b/lib/c-strcasecmp.c
@@ -0,0 +1,57 @@
+/* c-strcasecmp.c -- case insensitive string comparator in C locale
+   Copyright (C) 1998-1999, 2005-2006 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 2, 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, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "c-strcase.h"
+
+#include <limits.h>
+
+#include "c-ctype.h"
+
+int
+c_strcasecmp (const char *s1, const char *s2)
+{
+  register const unsigned char *p1 = (const unsigned char *) s1;
+  register const unsigned char *p2 = (const unsigned char *) s2;
+  unsigned char c1, c2;
+
+  if (p1 == p2)
+    return 0;
+
+  do
+    {
+      c1 = c_tolower (*p1);
+      c2 = c_tolower (*p2);
+
+      if (c1 == '\0')
+	break;
+
+      ++p1;
+      ++p2;
+    }
+  while (c1 == c2);
+
+  if (UCHAR_MAX <= INT_MAX)
+    return c1 - c2;
+  else
+    /* On machines where 'char' and 'int' are types of the same size, the
+       difference of two 'unsigned char' values - including the sign bit -
+       doesn't fit in an 'int'.  */
+    return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+}
diff --git a/lib/c-strcaseeq.h b/lib/c-strcaseeq.h
new file mode 100644
index 000000000..cd29b66c7
--- /dev/null
+++ b/lib/c-strcaseeq.h
@@ -0,0 +1,184 @@
+/* Optimized case-insensitive string comparison in C locale.
+   Copyright (C) 2001-2002, 2007 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* Written by Bruno Haible <bruno@clisp.org>.  */
+
+#include "c-strcase.h"
+#include "c-ctype.h"
+
+/* STRCASEEQ allows to optimize string comparison with a small literal string.
+     STRCASEEQ (s, "UTF-8", 'U','T','F','-','8',0,0,0,0)
+   is semantically equivalent to
+     c_strcasecmp (s, "UTF-8") == 0
+   just faster.  */
+
+/* Help GCC to generate good code for string comparisons with
+   immediate strings. */
+#if defined (__GNUC__) && defined (__OPTIMIZE__)
+
+/* Case insensitive comparison of ASCII characters.  */
+# if C_CTYPE_ASCII
+#  define CASEEQ(other,upper) \
+     (c_isupper (upper) ? ((other) & ~0x20) == (upper) : (other) == (upper))
+# elif C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#  define CASEEQ(other,upper) \
+     (c_isupper (upper) ? (other) == (upper) || (other) == (upper) - 'A' + 'a' : (other) == (upper))
+# else
+#  define CASEEQ(other,upper) \
+     (c_toupper (other) == (upper))
+# endif
+
+static inline int
+strcaseeq9 (const char *s1, const char *s2)
+{
+  return c_strcasecmp (s1 + 9, s2 + 9) == 0;
+}
+
+static inline int
+strcaseeq8 (const char *s1, const char *s2, char s28)
+{
+  if (CASEEQ (s1[8], s28))
+    {
+      if (s28 == 0)
+        return 1;
+      else
+        return strcaseeq9 (s1, s2);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq7 (const char *s1, const char *s2, char s27, char s28)
+{
+  if (CASEEQ (s1[7], s27))
+    {
+      if (s27 == 0)
+        return 1;
+      else
+        return strcaseeq8 (s1, s2, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq6 (const char *s1, const char *s2, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[6], s26))
+    {
+      if (s26 == 0)
+        return 1;
+      else
+        return strcaseeq7 (s1, s2, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq5 (const char *s1, const char *s2, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[5], s25))
+    {
+      if (s25 == 0)
+        return 1;
+      else
+        return strcaseeq6 (s1, s2, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq4 (const char *s1, const char *s2, char s24, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[4], s24))
+    {
+      if (s24 == 0)
+        return 1;
+      else
+        return strcaseeq5 (s1, s2, s25, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq3 (const char *s1, const char *s2, char s23, char s24, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[3], s23))
+    {
+      if (s23 == 0)
+        return 1;
+      else
+        return strcaseeq4 (s1, s2, s24, s25, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq2 (const char *s1, const char *s2, char s22, char s23, char s24, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[2], s22))
+    {
+      if (s22 == 0)
+        return 1;
+      else
+        return strcaseeq3 (s1, s2, s23, s24, s25, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq1 (const char *s1, const char *s2, char s21, char s22, char s23, char s24, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[1], s21))
+    {
+      if (s21 == 0)
+        return 1;
+      else
+        return strcaseeq2 (s1, s2, s22, s23, s24, s25, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq0 (const char *s1, const char *s2, char s20, char s21, char s22, char s23, char s24, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[0], s20))
+    {
+      if (s20 == 0)
+        return 1;
+      else
+        return strcaseeq1 (s1, s2, s21, s22, s23, s24, s25, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+#define STRCASEEQ(s1,s2,s20,s21,s22,s23,s24,s25,s26,s27,s28) \
+  strcaseeq0 (s1, s2, s20, s21, s22, s23, s24, s25, s26, s27, s28)
+
+#else
+
+#define STRCASEEQ(s1,s2,s20,s21,s22,s23,s24,s25,s26,s27,s28) \
+  (c_strcasecmp (s1, s2) == 0)
+
+#endif
diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c
new file mode 100644
index 000000000..c1496ca41
--- /dev/null
+++ b/lib/c-strncasecmp.c
@@ -0,0 +1,57 @@
+/* c-strncasecmp.c -- case insensitive string comparator in C locale
+   Copyright (C) 1998-1999, 2005-2006 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 2, 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, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "c-strcase.h"
+
+#include <limits.h>
+
+#include "c-ctype.h"
+
+int
+c_strncasecmp (const char *s1, const char *s2, size_t n)
+{
+  register const unsigned char *p1 = (const unsigned char *) s1;
+  register const unsigned char *p2 = (const unsigned char *) s2;
+  unsigned char c1, c2;
+
+  if (p1 == p2 || n == 0)
+    return 0;
+
+  do
+    {
+      c1 = c_tolower (*p1);
+      c2 = c_tolower (*p2);
+
+      if (--n == 0 || c1 == '\0')
+	break;
+
+      ++p1;
+      ++p2;
+    }
+  while (c1 == c2);
+
+  if (UCHAR_MAX <= INT_MAX)
+    return c1 - c2;
+  else
+    /* On machines where 'char' and 'int' are types of the same size, the
+       difference of two 'unsigned char' values - including the sign bit -
+       doesn't fit in an 'int'.  */
+    return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+}
diff --git a/lib/iconv.c b/lib/iconv.c
new file mode 100644
index 000000000..56a84c456
--- /dev/null
+++ b/lib/iconv.c
@@ -0,0 +1,450 @@
+/* Character set conversion.
+   Copyright (C) 1999-2001, 2007 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 2, 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, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <iconv.h>
+
+#include <stddef.h>
+
+#if REPLACE_ICONV_UTF
+# include <errno.h>
+# include <stdint.h>
+# include <stdlib.h>
+# include "unistr.h"
+# ifndef uintptr_t
+#  define uintptr_t unsigned long
+# endif
+#endif
+
+#if REPLACE_ICONV_UTF
+
+/* UTF-{16,32}{BE,LE} converters taken from GNU libiconv 1.11.  */
+
+/* Return code if invalid. (xxx_mbtowc) */
+# define RET_ILSEQ      -1
+/* Return code if no bytes were read. (xxx_mbtowc) */
+# define RET_TOOFEW     -2
+
+/* Return code if invalid. (xxx_wctomb) */
+# define RET_ILUNI      -1
+/* Return code if output buffer is too small. (xxx_wctomb, xxx_reset) */
+# define RET_TOOSMALL   -2
+
+/*
+ * UTF-16BE
+ */
+
+/* Specification: RFC 2781 */
+
+static int
+utf16be_mbtowc (ucs4_t *pwc, const unsigned char *s, size_t n)
+{
+  if (n >= 2)
+    {
+      ucs4_t wc = (s[0] << 8) + s[1];
+      if (wc >= 0xd800 && wc < 0xdc00)
+	{
+	  if (n >= 4)
+	    {
+	      ucs4_t wc2 = (s[2] << 8) + s[3];
+	      if (!(wc2 >= 0xdc00 && wc2 < 0xe000))
+		return RET_ILSEQ;
+	      *pwc = 0x10000 + ((wc - 0xd800) << 10) + (wc2 - 0xdc00);
+	      return 4;
+	    }
+	}
+      else if (wc >= 0xdc00 && wc < 0xe000)
+	{
+	  return RET_ILSEQ;
+	}
+      else
+	{
+	  *pwc = wc;
+	  return 2;
+	}
+    }
+  return RET_TOOFEW;
+}
+
+static int
+utf16be_wctomb (unsigned char *r, ucs4_t wc, size_t n)
+{
+  if (!(wc >= 0xd800 && wc < 0xe000))
+    {
+      if (wc < 0x10000)
+	{
+	  if (n >= 2)
+	    {
+	      r[0] = (unsigned char) (wc >> 8);
+	      r[1] = (unsigned char) wc;
+	      return 2;
+	    }
+	  else
+	    return RET_TOOSMALL;
+	}
+      else if (wc < 0x110000)
+	{
+	  if (n >= 4)
+	    {
+	      ucs4_t wc1 = 0xd800 + ((wc - 0x10000) >> 10);
+	      ucs4_t wc2 = 0xdc00 + ((wc - 0x10000) & 0x3ff);
+	      r[0] = (unsigned char) (wc1 >> 8);
+	      r[1] = (unsigned char) wc1;
+	      r[2] = (unsigned char) (wc2 >> 8);
+	      r[3] = (unsigned char) wc2;
+	      return 4;
+	    }
+	  else
+	    return RET_TOOSMALL;
+	}
+    }
+  return RET_ILUNI;
+}
+
+/*
+ * UTF-16LE
+ */
+
+/* Specification: RFC 2781 */
+
+static int
+utf16le_mbtowc (ucs4_t *pwc, const unsigned char *s, size_t n)
+{
+  if (n >= 2)
+    {
+      ucs4_t wc = s[0] + (s[1] << 8);
+      if (wc >= 0xd800 && wc < 0xdc00)
+	{
+	  if (n >= 4)
+	    {
+	      ucs4_t wc2 = s[2] + (s[3] << 8);
+	      if (!(wc2 >= 0xdc00 && wc2 < 0xe000))
+		return RET_ILSEQ;
+	      *pwc = 0x10000 + ((wc - 0xd800) << 10) + (wc2 - 0xdc00);
+	      return 4;
+	    }
+	}
+      else if (wc >= 0xdc00 && wc < 0xe000)
+	{
+	  return RET_ILSEQ;
+	}
+      else
+	{
+	  *pwc = wc;
+	  return 2;
+	}
+    }
+  return RET_TOOFEW;
+}
+
+static int
+utf16le_wctomb (unsigned char *r, ucs4_t wc, size_t n)
+{
+  if (!(wc >= 0xd800 && wc < 0xe000))
+    {
+      if (wc < 0x10000)
+	{
+	  if (n >= 2)
+	    {
+	      r[0] = (unsigned char) wc;
+	      r[1] = (unsigned char) (wc >> 8);
+	      return 2;
+	    }
+	  else
+	    return RET_TOOSMALL;
+	}
+      else if (wc < 0x110000)
+	{
+	  if (n >= 4)
+	    {
+	      ucs4_t wc1 = 0xd800 + ((wc - 0x10000) >> 10);
+	      ucs4_t wc2 = 0xdc00 + ((wc - 0x10000) & 0x3ff);
+	      r[0] = (unsigned char) wc1;
+	      r[1] = (unsigned char) (wc1 >> 8);
+	      r[2] = (unsigned char) wc2;
+	      r[3] = (unsigned char) (wc2 >> 8);
+	      return 4;
+	    }
+	  else
+	    return RET_TOOSMALL;
+	}
+    }
+  return RET_ILUNI;
+}
+
+/*
+ * UTF-32BE
+ */
+
+/* Specification: Unicode 3.1 Standard Annex #19 */
+
+static int
+utf32be_mbtowc (ucs4_t *pwc, const unsigned char *s, size_t n)
+{
+  if (n >= 4)
+    {
+      ucs4_t wc = (s[0] << 24) + (s[1] << 16) + (s[2] << 8) + s[3];
+      if (wc < 0x110000 && !(wc >= 0xd800 && wc < 0xe000))
+	{
+	  *pwc = wc;
+	  return 4;
+	}
+      else
+	return RET_ILSEQ;
+    }
+  return RET_TOOFEW;
+}
+
+static int
+utf32be_wctomb (unsigned char *r, ucs4_t wc, size_t n)
+{
+  if (wc < 0x110000 && !(wc >= 0xd800 && wc < 0xe000))
+    {
+      if (n >= 4)
+	{
+	  r[0] = 0;
+	  r[1] = (unsigned char) (wc >> 16);
+	  r[2] = (unsigned char) (wc >> 8);
+	  r[3] = (unsigned char) wc;
+	  return 4;
+	}
+      else
+	return RET_TOOSMALL;
+    }
+  return RET_ILUNI;
+}
+
+/*
+ * UTF-32LE
+ */
+
+/* Specification: Unicode 3.1 Standard Annex #19 */
+
+static int
+utf32le_mbtowc (ucs4_t *pwc, const unsigned char *s, size_t n)
+{
+  if (n >= 4)
+    {
+      ucs4_t wc = s[0] + (s[1] << 8) + (s[2] << 16) + (s[3] << 24);
+      if (wc < 0x110000 && !(wc >= 0xd800 && wc < 0xe000))
+	{
+	  *pwc = wc;
+	  return 4;
+	}
+      else
+	return RET_ILSEQ;
+    }
+  return RET_TOOFEW;
+}
+
+static int
+utf32le_wctomb (unsigned char *r, ucs4_t wc, size_t n)
+{
+  if (wc < 0x110000 && !(wc >= 0xd800 && wc < 0xe000))
+    {
+      if (n >= 4)
+	{
+	  r[0] = (unsigned char) wc;
+	  r[1] = (unsigned char) (wc >> 8);
+	  r[2] = (unsigned char) (wc >> 16);
+	  r[3] = 0;
+	  return 4;
+        }
+      else
+	return RET_TOOSMALL;
+    }
+  return RET_ILUNI;
+}
+
+#endif
+
+size_t
+rpl_iconv (iconv_t cd,
+	   ICONV_CONST char **inbuf, size_t *inbytesleft,
+	   char **outbuf, size_t *outbytesleft)
+#undef iconv
+{
+#if REPLACE_ICONV_UTF
+  switch ((uintptr_t) cd)
+    {
+      {
+	int (*xxx_wctomb) (unsigned char *, ucs4_t, size_t);
+
+	case (uintptr_t) _ICONV_UTF8_UTF16BE:
+	  xxx_wctomb = utf16be_wctomb;
+	  goto loop_from_utf8;
+	case (uintptr_t) _ICONV_UTF8_UTF16LE:
+	  xxx_wctomb = utf16le_wctomb;
+	  goto loop_from_utf8;
+	case (uintptr_t) _ICONV_UTF8_UTF32BE:
+	  xxx_wctomb = utf32be_wctomb;
+	  goto loop_from_utf8;
+	case (uintptr_t) _ICONV_UTF8_UTF32LE:
+	  xxx_wctomb = utf32le_wctomb;
+	  goto loop_from_utf8;
+
+       loop_from_utf8:
+	if (inbuf == NULL || *inbuf == NULL)
+	  return 0;
+	{
+	  ICONV_CONST char *inptr = *inbuf;
+	  size_t inleft = *inbytesleft;
+	  char *outptr = *outbuf;
+	  size_t outleft = *outbytesleft;
+	  size_t res = 0;
+	  while (inleft > 0)
+	    {
+	      ucs4_t uc;
+	      int m = u8_mbtoucr (&uc, (const uint8_t *) inptr, inleft);
+	      if (m <= 0)
+		{
+		  if (m == -1)
+		    {
+		      errno = EILSEQ;
+		      res = (size_t)(-1);
+		      break;
+		    }
+		  if (m == -2)
+		    {
+		      errno = EINVAL;
+		      res = (size_t)(-1);
+		      break;
+		    }
+		  abort ();
+		}
+	      else
+		{
+		  int n = xxx_wctomb ((uint8_t *) outptr, uc, outleft);
+		  if (n < 0)
+		    {
+		      if (n == RET_ILUNI)
+			{
+			  errno = EILSEQ;
+			  res = (size_t)(-1);
+			  break;
+			}
+		      if (n == RET_TOOSMALL)
+			{
+			  errno = E2BIG;
+			  res = (size_t)(-1);
+			  break;
+			}
+		      abort ();
+		    }
+		  else
+		    {
+		      inptr += m;
+		      inleft -= m;
+		      outptr += n;
+		      outleft -= n;
+		    }
+		}
+	    }
+	  *inbuf = inptr;
+	  *inbytesleft = inleft;
+	  *outbuf = outptr;
+	  *outbytesleft = outleft;
+	  return res;
+	}
+      }
+
+      {
+	int (*xxx_mbtowc) (ucs4_t *, const unsigned char *, size_t);
+
+	case (uintptr_t) _ICONV_UTF16BE_UTF8:
+	  xxx_mbtowc = utf16be_mbtowc;
+	  goto loop_to_utf8;
+	case (uintptr_t) _ICONV_UTF16LE_UTF8:
+	  xxx_mbtowc = utf16le_mbtowc;
+	  goto loop_to_utf8;
+	case (uintptr_t) _ICONV_UTF32BE_UTF8:
+	  xxx_mbtowc = utf32be_mbtowc;
+	  goto loop_to_utf8;
+	case (uintptr_t) _ICONV_UTF32LE_UTF8:
+	  xxx_mbtowc = utf32le_mbtowc;
+	  goto loop_to_utf8;
+
+       loop_to_utf8:
+	if (inbuf == NULL || *inbuf == NULL)
+	  return 0;
+	{
+	  ICONV_CONST char *inptr = *inbuf;
+	  size_t inleft = *inbytesleft;
+	  char *outptr = *outbuf;
+	  size_t outleft = *outbytesleft;
+	  size_t res = 0;
+	  while (inleft > 0)
+	    {
+	      ucs4_t uc;
+	      int m = xxx_mbtowc (&uc, (const uint8_t *) inptr, inleft);
+	      if (m <= 0)
+		{
+		  if (m == RET_ILSEQ)
+		    {
+		      errno = EILSEQ;
+		      res = (size_t)(-1);
+		      break;
+		    }
+		  if (m == RET_TOOFEW)
+		    {
+		      errno = EINVAL;
+		      res = (size_t)(-1);
+		      break;
+		    }
+		  abort ();
+		}
+	      else
+		{
+		  int n = u8_uctomb ((uint8_t *) outptr, uc, outleft);
+		  if (n < 0)
+		    {
+		      if (n == -1)
+			{
+			  errno = EILSEQ;
+			  res = (size_t)(-1);
+			  break;
+			}
+		      if (n == -2)
+			{
+			  errno = E2BIG;
+			  res = (size_t)(-1);
+			  break;
+			}
+		      abort ();
+		    }
+		  else
+		    {
+		      inptr += m;
+		      inleft -= m;
+		      outptr += n;
+		      outleft -= n;
+		    }
+		}
+	    }
+	  *inbuf = inptr;
+	  *inbytesleft = inleft;
+	  *outbuf = outptr;
+	  *outbytesleft = outleft;
+	  return res;
+	}
+      }
+    }
+#endif
+  return iconv (cd, inbuf, inbytesleft, outbuf, outbytesleft);
+}
diff --git a/lib/iconv.in.h b/lib/iconv.in.h
new file mode 100644
index 000000000..915dce2e7
--- /dev/null
+++ b/lib/iconv.in.h
@@ -0,0 +1,71 @@
+/* A GNU-like <iconv.h>.
+
+   Copyright (C) 2007-2008 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 2, 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, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _GL_ICONV_H
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+
+/* The include_next requires a split double-inclusion guard.  */
+#@INCLUDE_NEXT@ @NEXT_ICONV_H@
+
+#ifndef _GL_ICONV_H
+#define _GL_ICONV_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+#if @REPLACE_ICONV_OPEN@
+/* An iconv_open wrapper that supports the IANA standardized encoding names
+   ("ISO-8859-1" etc.) as far as possible.  */
+# define iconv_open rpl_iconv_open
+extern iconv_t iconv_open (const char *tocode, const char *fromcode);
+#endif
+
+#if @REPLACE_ICONV_UTF@
+/* Special constants for supporting UTF-{16,32}{BE,LE} encodings.
+   Not public.  */
+# define _ICONV_UTF8_UTF16BE (iconv_t)(-161)
+# define _ICONV_UTF8_UTF16LE (iconv_t)(-162)
+# define _ICONV_UTF8_UTF32BE (iconv_t)(-163)
+# define _ICONV_UTF8_UTF32LE (iconv_t)(-164)
+# define _ICONV_UTF16BE_UTF8 (iconv_t)(-165)
+# define _ICONV_UTF16LE_UTF8 (iconv_t)(-166)
+# define _ICONV_UTF32BE_UTF8 (iconv_t)(-167)
+# define _ICONV_UTF32LE_UTF8 (iconv_t)(-168)
+#endif
+
+#if @REPLACE_ICONV@
+# define iconv rpl_iconv
+extern size_t iconv (iconv_t cd,
+		     @ICONV_CONST@ char **inbuf, size_t *inbytesleft,
+		     char **outbuf, size_t *outbytesleft);
+# define iconv_close rpl_iconv_close
+extern int iconv_close (iconv_t cd);
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _GL_ICONV_H */
+#endif /* _GL_ICONV_H */
diff --git a/lib/iconv_close.c b/lib/iconv_close.c
new file mode 100644
index 000000000..3680412a0
--- /dev/null
+++ b/lib/iconv_close.c
@@ -0,0 +1,47 @@
+/* Character set conversion.
+   Copyright (C) 2007 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 2, 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, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <iconv.h>
+
+#include <stdint.h>
+#ifndef uintptr_t
+# define uintptr_t unsigned long
+#endif
+
+int
+rpl_iconv_close (iconv_t cd)
+#undef iconv_close
+{
+#if REPLACE_ICONV_UTF
+  switch ((uintptr_t) cd)
+    {
+    case (uintptr_t) _ICONV_UTF8_UTF16BE:
+    case (uintptr_t) _ICONV_UTF8_UTF16LE:
+    case (uintptr_t) _ICONV_UTF8_UTF32BE:
+    case (uintptr_t) _ICONV_UTF8_UTF32LE:
+    case (uintptr_t) _ICONV_UTF16BE_UTF8:
+    case (uintptr_t) _ICONV_UTF16LE_UTF8:
+    case (uintptr_t) _ICONV_UTF32BE_UTF8:
+    case (uintptr_t) _ICONV_UTF32LE_UTF8:
+      return 0;
+    }
+#endif
+  return iconv_close (cd);
+}
diff --git a/lib/iconv_open-aix.gperf b/lib/iconv_open-aix.gperf
new file mode 100644
index 000000000..6782b9956
--- /dev/null
+++ b/lib/iconv_open-aix.gperf
@@ -0,0 +1,44 @@
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+%struct-type
+%language=ANSI-C
+%define slot-name standard_name
+%define hash-function-name mapping_hash
+%define lookup-function-name mapping_lookup
+%readonly-tables
+%global-table
+%define word-array-name mappings
+%pic
+%%
+# On AIX 5.1, look in /usr/lib/nls/loc/uconvTable.
+ISO-8859-1, "ISO8859-1"
+ISO-8859-2, "ISO8859-2"
+ISO-8859-3, "ISO8859-3"
+ISO-8859-4, "ISO8859-4"
+ISO-8859-5, "ISO8859-5"
+ISO-8859-6, "ISO8859-6"
+ISO-8859-7, "ISO8859-7"
+ISO-8859-8, "ISO8859-8"
+ISO-8859-9, "ISO8859-9"
+ISO-8859-15, "ISO8859-15"
+CP437, "IBM-437"
+CP850, "IBM-850"
+CP852, "IBM-852"
+CP856, "IBM-856"
+CP857, "IBM-857"
+CP861, "IBM-861"
+CP865, "IBM-865"
+CP869, "IBM-869"
+ISO-8859-13, "IBM-921"
+CP922, "IBM-922"
+CP932, "IBM-932"
+CP943, "IBM-943"
+CP1046, "IBM-1046"
+CP1124, "IBM-1124"
+CP1125, "IBM-1125"
+CP1129, "IBM-1129"
+CP1252, "IBM-1252"
+GB2312, "IBM-eucCN"
+EUC-JP, "IBM-eucJP"
+EUC-KR, "IBM-eucKR"
+EUC-TW, "IBM-eucTW"
+BIG5, "big5"
diff --git a/lib/iconv_open-aix.h b/lib/iconv_open-aix.h
new file mode 100644
index 000000000..0ffc3fef1
--- /dev/null
+++ b/lib/iconv_open-aix.h
@@ -0,0 +1,256 @@
+/* ANSI-C code produced by gperf version 3.0.3 */
+/* Command-line: gperf -m 10 ./iconv_open-aix.gperf  */
+/* Computed positions: -k'4,$' */
+
+#if !((' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+      && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+      && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+      && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+      && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+      && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+      && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+      && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+      && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+      && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+      && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+      && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+      && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+      && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+      && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+      && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+      && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+      && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+      && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+      && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+      && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+      && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+      && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126))
+/* The character set is not based on ISO-646.  */
+#error "gperf generated tables don't work with this execution character set. Please report a bug to <bug-gnu-gperf@gnu.org>."
+#endif
+
+#line 1 "./iconv_open-aix.gperf"
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+
+#define TOTAL_KEYWORDS 32
+#define MIN_WORD_LENGTH 4
+#define MAX_WORD_LENGTH 11
+#define MIN_HASH_VALUE 6
+#define MAX_HASH_VALUE 44
+/* maximum key range = 39, duplicates = 0 */
+
+#ifdef __GNUC__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static unsigned int
+mapping_hash (register const char *str, register unsigned int len)
+{
+  static const unsigned char asso_values[] =
+    {
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45,  0,  4, 25,
+       0, 11, 24,  9, 17,  3, 14, 21, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+       3, 45,  1, 45, 45, 45, 45,  0, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45
+    };
+  return len + asso_values[(unsigned char)str[3]+2] + asso_values[(unsigned char)str[len - 1]];
+}
+
+struct stringpool_t
+  {
+    char stringpool_str6[sizeof("EUC-TW")];
+    char stringpool_str7[sizeof("EUC-KR")];
+    char stringpool_str8[sizeof("CP852")];
+    char stringpool_str9[sizeof("EUC-JP")];
+    char stringpool_str10[sizeof("ISO-8859-2")];
+    char stringpool_str11[sizeof("CP857")];
+    char stringpool_str12[sizeof("CP850")];
+    char stringpool_str13[sizeof("ISO-8859-7")];
+    char stringpool_str14[sizeof("CP932")];
+    char stringpool_str15[sizeof("GB2312")];
+    char stringpool_str16[sizeof("BIG5")];
+    char stringpool_str17[sizeof("CP437")];
+    char stringpool_str19[sizeof("ISO-8859-5")];
+    char stringpool_str20[sizeof("ISO-8859-15")];
+    char stringpool_str21[sizeof("ISO-8859-3")];
+    char stringpool_str22[sizeof("ISO-8859-13")];
+    char stringpool_str23[sizeof("CP1046")];
+    char stringpool_str24[sizeof("ISO-8859-8")];
+    char stringpool_str25[sizeof("CP856")];
+    char stringpool_str26[sizeof("CP1125")];
+    char stringpool_str27[sizeof("ISO-8859-6")];
+    char stringpool_str28[sizeof("CP865")];
+    char stringpool_str29[sizeof("CP922")];
+    char stringpool_str30[sizeof("CP1252")];
+    char stringpool_str31[sizeof("ISO-8859-9")];
+    char stringpool_str33[sizeof("CP943")];
+    char stringpool_str34[sizeof("ISO-8859-4")];
+    char stringpool_str35[sizeof("ISO-8859-1")];
+    char stringpool_str38[sizeof("CP1129")];
+    char stringpool_str40[sizeof("CP869")];
+    char stringpool_str41[sizeof("CP1124")];
+    char stringpool_str44[sizeof("CP861")];
+  };
+static const struct stringpool_t stringpool_contents =
+  {
+    "EUC-TW",
+    "EUC-KR",
+    "CP852",
+    "EUC-JP",
+    "ISO-8859-2",
+    "CP857",
+    "CP850",
+    "ISO-8859-7",
+    "CP932",
+    "GB2312",
+    "BIG5",
+    "CP437",
+    "ISO-8859-5",
+    "ISO-8859-15",
+    "ISO-8859-3",
+    "ISO-8859-13",
+    "CP1046",
+    "ISO-8859-8",
+    "CP856",
+    "CP1125",
+    "ISO-8859-6",
+    "CP865",
+    "CP922",
+    "CP1252",
+    "ISO-8859-9",
+    "CP943",
+    "ISO-8859-4",
+    "ISO-8859-1",
+    "CP1129",
+    "CP869",
+    "CP1124",
+    "CP861"
+  };
+#define stringpool ((const char *) &stringpool_contents)
+
+static const struct mapping mappings[] =
+  {
+    {-1}, {-1}, {-1}, {-1}, {-1}, {-1},
+#line 43 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str6, "IBM-eucTW"},
+#line 42 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str7, "IBM-eucKR"},
+#line 25 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str8, "IBM-852"},
+#line 41 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str9, "IBM-eucJP"},
+#line 14 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str10, "ISO8859-2"},
+#line 27 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str11, "IBM-857"},
+#line 24 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str12, "IBM-850"},
+#line 19 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str13, "ISO8859-7"},
+#line 33 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str14, "IBM-932"},
+#line 40 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str15, "IBM-eucCN"},
+#line 44 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str16, "big5"},
+#line 23 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str17, "IBM-437"},
+    {-1},
+#line 17 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str19, "ISO8859-5"},
+#line 22 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str20, "ISO8859-15"},
+#line 15 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str21, "ISO8859-3"},
+#line 31 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str22, "IBM-921"},
+#line 35 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str23, "IBM-1046"},
+#line 20 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str24, "ISO8859-8"},
+#line 26 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str25, "IBM-856"},
+#line 37 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str26, "IBM-1125"},
+#line 18 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str27, "ISO8859-6"},
+#line 29 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str28, "IBM-865"},
+#line 32 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str29, "IBM-922"},
+#line 39 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str30, "IBM-1252"},
+#line 21 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str31, "ISO8859-9"},
+    {-1},
+#line 34 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str33, "IBM-943"},
+#line 16 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str34, "ISO8859-4"},
+#line 13 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str35, "ISO8859-1"},
+    {-1}, {-1},
+#line 38 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str38, "IBM-1129"},
+    {-1},
+#line 30 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str40, "IBM-869"},
+#line 36 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str41, "IBM-1124"},
+    {-1}, {-1},
+#line 28 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str44, "IBM-861"}
+  };
+
+#ifdef __GNUC__
+__inline
+#ifdef __GNUC_STDC_INLINE__
+__attribute__ ((__gnu_inline__))
+#endif
+#endif
+const struct mapping *
+mapping_lookup (register const char *str, register unsigned int len)
+{
+  if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH)
+    {
+      register int key = mapping_hash (str, len);
+
+      if (key <= MAX_HASH_VALUE && key >= 0)
+        {
+          register int o = mappings[key].standard_name;
+          if (o >= 0)
+            {
+              register const char *s = o + stringpool;
+
+              if (*str == *s && !strcmp (str + 1, s + 1))
+                return &mappings[key];
+            }
+        }
+    }
+  return 0;
+}
diff --git a/lib/iconv_open-hpux.gperf b/lib/iconv_open-hpux.gperf
new file mode 100644
index 000000000..5a35c83e1
--- /dev/null
+++ b/lib/iconv_open-hpux.gperf
@@ -0,0 +1,56 @@
+struct mapping { int standard_name; const char vendor_name[9 + 1]; };
+%struct-type
+%language=ANSI-C
+%define slot-name standard_name
+%define hash-function-name mapping_hash
+%define lookup-function-name mapping_lookup
+%readonly-tables
+%global-table
+%define word-array-name mappings
+%pic
+%%
+# On HP-UX 11.11, look in /usr/lib/nls/iconv.
+ISO-8859-1, "iso88591"
+ISO-8859-2, "iso88592"
+ISO-8859-5, "iso88595"
+ISO-8859-6, "iso88596"
+ISO-8859-7, "iso88597"
+ISO-8859-8, "iso88598"
+ISO-8859-9, "iso88599"
+ISO-8859-15, "iso885915"
+CP437, "cp437"
+CP775, "cp775"
+CP850, "cp850"
+CP852, "cp852"
+CP855, "cp855"
+CP857, "cp857"
+CP861, "cp861"
+CP862, "cp862"
+CP864, "cp864"
+CP865, "cp865"
+CP866, "cp866"
+CP869, "cp869"
+CP874, "cp874"
+CP1250, "cp1250"
+CP1251, "cp1251"
+CP1252, "cp1252"
+CP1253, "cp1253"
+CP1254, "cp1254"
+CP1255, "cp1255"
+CP1256, "cp1256"
+CP1257, "cp1257"
+CP1258, "cp1258"
+HP-ROMAN8, "roman8"
+HP-ARABIC8, "arabic8"
+HP-GREEK8, "greek8"
+HP-HEBREW8, "hebrew8"
+HP-TURKISH8, "turkish8"
+HP-KANA8, "kana8"
+TIS-620, "tis620"
+GB2312, "hp15CN"
+EUC-JP, "eucJP"
+EUC-KR, "eucKR"
+EUC-TW, "eucTW"
+BIG5, "big5"
+SHIFT_JIS, "sjis"
+UTF-8, "utf8"
diff --git a/lib/iconv_open-hpux.h b/lib/iconv_open-hpux.h
new file mode 100644
index 000000000..8f9f0a9ad
--- /dev/null
+++ b/lib/iconv_open-hpux.h
@@ -0,0 +1,299 @@
+/* ANSI-C code produced by gperf version 3.0.3 */
+/* Command-line: gperf -m 10 ./iconv_open-hpux.gperf  */
+/* Computed positions: -k'4,$' */
+
+#if !((' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+      && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+      && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+      && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+      && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+      && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+      && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+      && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+      && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+      && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+      && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+      && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+      && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+      && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+      && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+      && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+      && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+      && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+      && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+      && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+      && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+      && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+      && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126))
+/* The character set is not based on ISO-646.  */
+#error "gperf generated tables don't work with this execution character set. Please report a bug to <bug-gnu-gperf@gnu.org>."
+#endif
+
+#line 1 "./iconv_open-hpux.gperf"
+struct mapping { int standard_name; const char vendor_name[9 + 1]; };
+
+#define TOTAL_KEYWORDS 44
+#define MIN_WORD_LENGTH 4
+#define MAX_WORD_LENGTH 11
+#define MIN_HASH_VALUE 6
+#define MAX_HASH_VALUE 49
+/* maximum key range = 44, duplicates = 0 */
+
+#ifdef __GNUC__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static unsigned int
+mapping_hash (register const char *str, register unsigned int len)
+{
+  static const unsigned char asso_values[] =
+    {
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50,  1,  2,
+      24, 43,  5, 10,  0, 13, 32,  3, 19, 18,
+      50, 50, 50, 50, 50, 50, 50, 50, 50,  5,
+      50, 50, 50, 50, 14,  5,  0, 50, 50,  0,
+      27, 50, 12, 14, 50, 50,  0,  5,  2, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50
+    };
+  return len + asso_values[(unsigned char)str[3]+4] + asso_values[(unsigned char)str[len - 1]];
+}
+
+struct stringpool_t
+  {
+    char stringpool_str6[sizeof("CP1256")];
+    char stringpool_str7[sizeof("CP1250")];
+    char stringpool_str8[sizeof("CP1251")];
+    char stringpool_str9[sizeof("CP850")];
+    char stringpool_str10[sizeof("TIS-620")];
+    char stringpool_str11[sizeof("CP1254")];
+    char stringpool_str12[sizeof("ISO-8859-6")];
+    char stringpool_str13[sizeof("EUC-TW")];
+    char stringpool_str14[sizeof("ISO-8859-1")];
+    char stringpool_str15[sizeof("ISO-8859-9")];
+    char stringpool_str16[sizeof("CP1255")];
+    char stringpool_str17[sizeof("BIG5")];
+    char stringpool_str18[sizeof("CP855")];
+    char stringpool_str19[sizeof("CP1257")];
+    char stringpool_str20[sizeof("EUC-KR")];
+    char stringpool_str21[sizeof("CP857")];
+    char stringpool_str22[sizeof("ISO-8859-5")];
+    char stringpool_str23[sizeof("ISO-8859-15")];
+    char stringpool_str24[sizeof("CP866")];
+    char stringpool_str25[sizeof("ISO-8859-7")];
+    char stringpool_str26[sizeof("CP861")];
+    char stringpool_str27[sizeof("CP869")];
+    char stringpool_str28[sizeof("CP874")];
+    char stringpool_str29[sizeof("CP864")];
+    char stringpool_str30[sizeof("CP1252")];
+    char stringpool_str31[sizeof("CP437")];
+    char stringpool_str32[sizeof("CP852")];
+    char stringpool_str33[sizeof("CP775")];
+    char stringpool_str34[sizeof("CP865")];
+    char stringpool_str35[sizeof("EUC-JP")];
+    char stringpool_str36[sizeof("ISO-8859-2")];
+    char stringpool_str37[sizeof("SHIFT_JIS")];
+    char stringpool_str38[sizeof("CP1258")];
+    char stringpool_str39[sizeof("UTF-8")];
+    char stringpool_str40[sizeof("HP-KANA8")];
+    char stringpool_str41[sizeof("HP-ROMAN8")];
+    char stringpool_str42[sizeof("HP-HEBREW8")];
+    char stringpool_str43[sizeof("GB2312")];
+    char stringpool_str44[sizeof("ISO-8859-8")];
+    char stringpool_str45[sizeof("HP-TURKISH8")];
+    char stringpool_str46[sizeof("HP-GREEK8")];
+    char stringpool_str47[sizeof("HP-ARABIC8")];
+    char stringpool_str48[sizeof("CP862")];
+    char stringpool_str49[sizeof("CP1253")];
+  };
+static const struct stringpool_t stringpool_contents =
+  {
+    "CP1256",
+    "CP1250",
+    "CP1251",
+    "CP850",
+    "TIS-620",
+    "CP1254",
+    "ISO-8859-6",
+    "EUC-TW",
+    "ISO-8859-1",
+    "ISO-8859-9",
+    "CP1255",
+    "BIG5",
+    "CP855",
+    "CP1257",
+    "EUC-KR",
+    "CP857",
+    "ISO-8859-5",
+    "ISO-8859-15",
+    "CP866",
+    "ISO-8859-7",
+    "CP861",
+    "CP869",
+    "CP874",
+    "CP864",
+    "CP1252",
+    "CP437",
+    "CP852",
+    "CP775",
+    "CP865",
+    "EUC-JP",
+    "ISO-8859-2",
+    "SHIFT_JIS",
+    "CP1258",
+    "UTF-8",
+    "HP-KANA8",
+    "HP-ROMAN8",
+    "HP-HEBREW8",
+    "GB2312",
+    "ISO-8859-8",
+    "HP-TURKISH8",
+    "HP-GREEK8",
+    "HP-ARABIC8",
+    "CP862",
+    "CP1253"
+  };
+#define stringpool ((const char *) &stringpool_contents)
+
+static const struct mapping mappings[] =
+  {
+    {-1}, {-1}, {-1}, {-1}, {-1}, {-1},
+#line 40 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str6, "cp1256"},
+#line 34 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str7, "cp1250"},
+#line 35 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str8, "cp1251"},
+#line 23 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str9, "cp850"},
+#line 49 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str10, "tis620"},
+#line 38 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str11, "cp1254"},
+#line 16 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str12, "iso88596"},
+#line 53 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str13, "eucTW"},
+#line 13 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str14, "iso88591"},
+#line 19 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str15, "iso88599"},
+#line 39 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str16, "cp1255"},
+#line 54 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str17, "big5"},
+#line 25 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str18, "cp855"},
+#line 41 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str19, "cp1257"},
+#line 52 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str20, "eucKR"},
+#line 26 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str21, "cp857"},
+#line 15 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str22, "iso88595"},
+#line 20 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str23, "iso885915"},
+#line 31 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str24, "cp866"},
+#line 17 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str25, "iso88597"},
+#line 27 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str26, "cp861"},
+#line 32 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str27, "cp869"},
+#line 33 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str28, "cp874"},
+#line 29 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str29, "cp864"},
+#line 36 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str30, "cp1252"},
+#line 21 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str31, "cp437"},
+#line 24 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str32, "cp852"},
+#line 22 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str33, "cp775"},
+#line 30 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str34, "cp865"},
+#line 51 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str35, "eucJP"},
+#line 14 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str36, "iso88592"},
+#line 55 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str37, "sjis"},
+#line 42 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str38, "cp1258"},
+#line 56 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str39, "utf8"},
+#line 48 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str40, "kana8"},
+#line 43 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str41, "roman8"},
+#line 46 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str42, "hebrew8"},
+#line 50 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str43, "hp15CN"},
+#line 18 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str44, "iso88598"},
+#line 47 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str45, "turkish8"},
+#line 45 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str46, "greek8"},
+#line 44 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str47, "arabic8"},
+#line 28 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str48, "cp862"},
+#line 37 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str49, "cp1253"}
+  };
+
+#ifdef __GNUC__
+__inline
+#ifdef __GNUC_STDC_INLINE__
+__attribute__ ((__gnu_inline__))
+#endif
+#endif
+const struct mapping *
+mapping_lookup (register const char *str, register unsigned int len)
+{
+  if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH)
+    {
+      register int key = mapping_hash (str, len);
+
+      if (key <= MAX_HASH_VALUE && key >= 0)
+        {
+          register int o = mappings[key].standard_name;
+          if (o >= 0)
+            {
+              register const char *s = o + stringpool;
+
+              if (*str == *s && !strcmp (str + 1, s + 1))
+                return &mappings[key];
+            }
+        }
+    }
+  return 0;
+}
diff --git a/lib/iconv_open-irix.gperf b/lib/iconv_open-irix.gperf
new file mode 100644
index 000000000..3672a8013
--- /dev/null
+++ b/lib/iconv_open-irix.gperf
@@ -0,0 +1,31 @@
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+%struct-type
+%language=ANSI-C
+%define slot-name standard_name
+%define hash-function-name mapping_hash
+%define lookup-function-name mapping_lookup
+%readonly-tables
+%global-table
+%define word-array-name mappings
+%pic
+%%
+# On IRIX 6.5, look in /usr/lib/iconv and /usr/lib/international/encodings.
+ISO-8859-1, "ISO8859-1"
+ISO-8859-2, "ISO8859-2"
+ISO-8859-3, "ISO8859-3"
+ISO-8859-4, "ISO8859-4"
+ISO-8859-5, "ISO8859-5"
+ISO-8859-6, "ISO8859-6"
+ISO-8859-7, "ISO8859-7"
+ISO-8859-8, "ISO8859-8"
+ISO-8859-9, "ISO8859-9"
+ISO-8859-15, "ISO8859-15"
+KOI8-R, "KOI8"
+CP855, "DOS855"
+CP1251, "WIN1251"
+GB2312, "eucCN"
+EUC-JP, "eucJP"
+EUC-KR, "eucKR"
+EUC-TW, "eucTW"
+SHIFT_JIS, "sjis"
+TIS-620, "TIS620"
diff --git a/lib/iconv_open-irix.h b/lib/iconv_open-irix.h
new file mode 100644
index 000000000..520582e52
--- /dev/null
+++ b/lib/iconv_open-irix.h
@@ -0,0 +1,199 @@
+/* ANSI-C code produced by gperf version 3.0.3 */
+/* Command-line: gperf -m 10 ./iconv_open-irix.gperf  */
+/* Computed positions: -k'1,$' */
+
+#if !((' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+      && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+      && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+      && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+      && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+      && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+      && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+      && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+      && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+      && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+      && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+      && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+      && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+      && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+      && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+      && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+      && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+      && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+      && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+      && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+      && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+      && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+      && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126))
+/* The character set is not based on ISO-646.  */
+#error "gperf generated tables don't work with this execution character set. Please report a bug to <bug-gnu-gperf@gnu.org>."
+#endif
+
+#line 1 "./iconv_open-irix.gperf"
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+
+#define TOTAL_KEYWORDS 19
+#define MIN_WORD_LENGTH 5
+#define MAX_WORD_LENGTH 11
+#define MIN_HASH_VALUE 5
+#define MAX_HASH_VALUE 23
+/* maximum key range = 19, duplicates = 0 */
+
+#ifdef __GNUC__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static unsigned int
+mapping_hash (register const char *str, register unsigned int len)
+{
+  static const unsigned char asso_values[] =
+    {
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24,  8,  2,
+       5, 12, 11,  0, 10,  9,  8,  7, 24, 24,
+      24, 24, 24, 24, 24, 24, 24,  0, 24,  0,
+      24,  5, 24,  0, 24,  7, 24, 24, 24, 24,
+       7, 24,  1,  0,  8, 24, 24,  0, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24
+    };
+  return len + asso_values[(unsigned char)str[len - 1]] + asso_values[(unsigned char)str[0]];
+}
+
+struct stringpool_t
+  {
+    char stringpool_str5[sizeof("CP855")];
+    char stringpool_str6[sizeof("EUC-TW")];
+    char stringpool_str7[sizeof("EUC-KR")];
+    char stringpool_str8[sizeof("CP1251")];
+    char stringpool_str9[sizeof("SHIFT_JIS")];
+    char stringpool_str10[sizeof("ISO-8859-5")];
+    char stringpool_str11[sizeof("ISO-8859-15")];
+    char stringpool_str12[sizeof("ISO-8859-1")];
+    char stringpool_str13[sizeof("EUC-JP")];
+    char stringpool_str14[sizeof("KOI8-R")];
+    char stringpool_str15[sizeof("ISO-8859-2")];
+    char stringpool_str16[sizeof("GB2312")];
+    char stringpool_str17[sizeof("ISO-8859-9")];
+    char stringpool_str18[sizeof("ISO-8859-8")];
+    char stringpool_str19[sizeof("ISO-8859-7")];
+    char stringpool_str20[sizeof("ISO-8859-6")];
+    char stringpool_str21[sizeof("ISO-8859-4")];
+    char stringpool_str22[sizeof("ISO-8859-3")];
+    char stringpool_str23[sizeof("TIS-620")];
+  };
+static const struct stringpool_t stringpool_contents =
+  {
+    "CP855",
+    "EUC-TW",
+    "EUC-KR",
+    "CP1251",
+    "SHIFT_JIS",
+    "ISO-8859-5",
+    "ISO-8859-15",
+    "ISO-8859-1",
+    "EUC-JP",
+    "KOI8-R",
+    "ISO-8859-2",
+    "GB2312",
+    "ISO-8859-9",
+    "ISO-8859-8",
+    "ISO-8859-7",
+    "ISO-8859-6",
+    "ISO-8859-4",
+    "ISO-8859-3",
+    "TIS-620"
+  };
+#define stringpool ((const char *) &stringpool_contents)
+
+static const struct mapping mappings[] =
+  {
+    {-1}, {-1}, {-1}, {-1}, {-1},
+#line 24 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str5, "DOS855"},
+#line 29 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str6, "eucTW"},
+#line 28 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str7, "eucKR"},
+#line 25 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str8, "WIN1251"},
+#line 30 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str9, "sjis"},
+#line 17 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str10, "ISO8859-5"},
+#line 22 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str11, "ISO8859-15"},
+#line 13 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str12, "ISO8859-1"},
+#line 27 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str13, "eucJP"},
+#line 23 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str14, "KOI8"},
+#line 14 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str15, "ISO8859-2"},
+#line 26 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str16, "eucCN"},
+#line 21 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str17, "ISO8859-9"},
+#line 20 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str18, "ISO8859-8"},
+#line 19 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str19, "ISO8859-7"},
+#line 18 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str20, "ISO8859-6"},
+#line 16 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str21, "ISO8859-4"},
+#line 15 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str22, "ISO8859-3"},
+#line 31 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str23, "TIS620"}
+  };
+
+#ifdef __GNUC__
+__inline
+#ifdef __GNUC_STDC_INLINE__
+__attribute__ ((__gnu_inline__))
+#endif
+#endif
+const struct mapping *
+mapping_lookup (register const char *str, register unsigned int len)
+{
+  if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH)
+    {
+      register int key = mapping_hash (str, len);
+
+      if (key <= MAX_HASH_VALUE && key >= 0)
+        {
+          register int o = mappings[key].standard_name;
+          if (o >= 0)
+            {
+              register const char *s = o + stringpool;
+
+              if (*str == *s && !strcmp (str + 1, s + 1))
+                return &mappings[key];
+            }
+        }
+    }
+  return 0;
+}
diff --git a/lib/iconv_open-osf.gperf b/lib/iconv_open-osf.gperf
new file mode 100644
index 000000000..f468ff609
--- /dev/null
+++ b/lib/iconv_open-osf.gperf
@@ -0,0 +1,50 @@
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+%struct-type
+%language=ANSI-C
+%define slot-name standard_name
+%define hash-function-name mapping_hash
+%define lookup-function-name mapping_lookup
+%readonly-tables
+%global-table
+%define word-array-name mappings
+%pic
+%%
+# On OSF/1 5.1, look in /usr/lib/nls/loc/iconv.
+ISO-8859-1, "ISO8859-1"
+ISO-8859-2, "ISO8859-2"
+ISO-8859-3, "ISO8859-3"
+ISO-8859-4, "ISO8859-4"
+ISO-8859-5, "ISO8859-5"
+ISO-8859-6, "ISO8859-6"
+ISO-8859-7, "ISO8859-7"
+ISO-8859-8, "ISO8859-8"
+ISO-8859-9, "ISO8859-9"
+ISO-8859-15, "ISO8859-15"
+CP437, "cp437"
+CP775, "cp775"
+CP850, "cp850"
+CP852, "cp852"
+CP855, "cp855"
+CP857, "cp857"
+CP861, "cp861"
+CP862, "cp862"
+CP865, "cp865"
+CP866, "cp866"
+CP869, "cp869"
+CP874, "cp874"
+CP949, "KSC5601"
+CP1250, "cp1250"
+CP1251, "cp1251"
+CP1252, "cp1252"
+CP1253, "cp1253"
+CP1254, "cp1254"
+CP1255, "cp1255"
+CP1256, "cp1256"
+CP1257, "cp1257"
+CP1258, "cp1258"
+EUC-JP, "eucJP"
+EUC-KR, "eucKR"
+EUC-TW, "eucTW"
+BIG5, "big5"
+SHIFT_JIS, "SJIS"
+TIS-620, "TACTIS"
diff --git a/lib/iconv_open-osf.h b/lib/iconv_open-osf.h
new file mode 100644
index 000000000..85e4c0f8f
--- /dev/null
+++ b/lib/iconv_open-osf.h
@@ -0,0 +1,278 @@
+/* ANSI-C code produced by gperf version 3.0.3 */
+/* Command-line: gperf -m 10 ./iconv_open-osf.gperf  */
+/* Computed positions: -k'4,$' */
+
+#if !((' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+      && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+      && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+      && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+      && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+      && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+      && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+      && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+      && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+      && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+      && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+      && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+      && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+      && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+      && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+      && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+      && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+      && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+      && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+      && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+      && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+      && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+      && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126))
+/* The character set is not based on ISO-646.  */
+#error "gperf generated tables don't work with this execution character set. Please report a bug to <bug-gnu-gperf@gnu.org>."
+#endif
+
+#line 1 "./iconv_open-osf.gperf"
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+
+#define TOTAL_KEYWORDS 38
+#define MIN_WORD_LENGTH 4
+#define MAX_WORD_LENGTH 11
+#define MIN_HASH_VALUE 6
+#define MAX_HASH_VALUE 47
+/* maximum key range = 42, duplicates = 0 */
+
+#ifdef __GNUC__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static unsigned int
+mapping_hash (register const char *str, register unsigned int len)
+{
+  static const unsigned char asso_values[] =
+    {
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48,  2, 29,
+      24, 34, 31,  0, 15, 14, 10, 13,  2, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48,  7, 48, 48, 48, 48, 48, 48,
+      11, 48,  2,  7, 48, 48, 48,  1, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48
+    };
+  return len + asso_values[(unsigned char)str[3]+3] + asso_values[(unsigned char)str[len - 1]];
+}
+
+struct stringpool_t
+  {
+    char stringpool_str6[sizeof("CP1255")];
+    char stringpool_str7[sizeof("CP775")];
+    char stringpool_str8[sizeof("CP1250")];
+    char stringpool_str9[sizeof("EUC-TW")];
+    char stringpool_str10[sizeof("EUC-KR")];
+    char stringpool_str11[sizeof("TIS-620")];
+    char stringpool_str12[sizeof("ISO-8859-5")];
+    char stringpool_str13[sizeof("ISO-8859-15")];
+    char stringpool_str14[sizeof("BIG5")];
+    char stringpool_str15[sizeof("CP855")];
+    char stringpool_str16[sizeof("CP1258")];
+    char stringpool_str17[sizeof("CP850")];
+    char stringpool_str18[sizeof("CP865")];
+    char stringpool_str19[sizeof("EUC-JP")];
+    char stringpool_str20[sizeof("CP1257")];
+    char stringpool_str21[sizeof("CP1256")];
+    char stringpool_str22[sizeof("ISO-8859-8")];
+    char stringpool_str23[sizeof("SHIFT_JIS")];
+    char stringpool_str25[sizeof("ISO-8859-9")];
+    char stringpool_str26[sizeof("ISO-8859-7")];
+    char stringpool_str27[sizeof("ISO-8859-6")];
+    char stringpool_str29[sizeof("CP857")];
+    char stringpool_str30[sizeof("CP1252")];
+    char stringpool_str31[sizeof("CP869")];
+    char stringpool_str32[sizeof("CP949")];
+    char stringpool_str33[sizeof("CP866")];
+    char stringpool_str34[sizeof("CP437")];
+    char stringpool_str35[sizeof("CP1251")];
+    char stringpool_str36[sizeof("ISO-8859-2")];
+    char stringpool_str37[sizeof("CP1254")];
+    char stringpool_str38[sizeof("CP874")];
+    char stringpool_str39[sizeof("CP852")];
+    char stringpool_str40[sizeof("CP1253")];
+    char stringpool_str41[sizeof("ISO-8859-1")];
+    char stringpool_str42[sizeof("CP862")];
+    char stringpool_str43[sizeof("ISO-8859-4")];
+    char stringpool_str46[sizeof("ISO-8859-3")];
+    char stringpool_str47[sizeof("CP861")];
+  };
+static const struct stringpool_t stringpool_contents =
+  {
+    "CP1255",
+    "CP775",
+    "CP1250",
+    "EUC-TW",
+    "EUC-KR",
+    "TIS-620",
+    "ISO-8859-5",
+    "ISO-8859-15",
+    "BIG5",
+    "CP855",
+    "CP1258",
+    "CP850",
+    "CP865",
+    "EUC-JP",
+    "CP1257",
+    "CP1256",
+    "ISO-8859-8",
+    "SHIFT_JIS",
+    "ISO-8859-9",
+    "ISO-8859-7",
+    "ISO-8859-6",
+    "CP857",
+    "CP1252",
+    "CP869",
+    "CP949",
+    "CP866",
+    "CP437",
+    "CP1251",
+    "ISO-8859-2",
+    "CP1254",
+    "CP874",
+    "CP852",
+    "CP1253",
+    "ISO-8859-1",
+    "CP862",
+    "ISO-8859-4",
+    "ISO-8859-3",
+    "CP861"
+  };
+#define stringpool ((const char *) &stringpool_contents)
+
+static const struct mapping mappings[] =
+  {
+    {-1}, {-1}, {-1}, {-1}, {-1}, {-1},
+#line 41 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str6, "cp1255"},
+#line 24 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str7, "cp775"},
+#line 36 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str8, "cp1250"},
+#line 47 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str9, "eucTW"},
+#line 46 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str10, "eucKR"},
+#line 50 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str11, "TACTIS"},
+#line 17 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str12, "ISO8859-5"},
+#line 22 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str13, "ISO8859-15"},
+#line 48 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str14, "big5"},
+#line 27 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str15, "cp855"},
+#line 44 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str16, "cp1258"},
+#line 25 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str17, "cp850"},
+#line 31 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str18, "cp865"},
+#line 45 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str19, "eucJP"},
+#line 43 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str20, "cp1257"},
+#line 42 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str21, "cp1256"},
+#line 20 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str22, "ISO8859-8"},
+#line 49 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str23, "SJIS"},
+    {-1},
+#line 21 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str25, "ISO8859-9"},
+#line 19 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str26, "ISO8859-7"},
+#line 18 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str27, "ISO8859-6"},
+    {-1},
+#line 28 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str29, "cp857"},
+#line 38 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str30, "cp1252"},
+#line 33 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str31, "cp869"},
+#line 35 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str32, "KSC5601"},
+#line 32 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str33, "cp866"},
+#line 23 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str34, "cp437"},
+#line 37 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str35, "cp1251"},
+#line 14 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str36, "ISO8859-2"},
+#line 40 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str37, "cp1254"},
+#line 34 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str38, "cp874"},
+#line 26 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str39, "cp852"},
+#line 39 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str40, "cp1253"},
+#line 13 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str41, "ISO8859-1"},
+#line 30 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str42, "cp862"},
+#line 16 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str43, "ISO8859-4"},
+    {-1}, {-1},
+#line 15 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str46, "ISO8859-3"},
+#line 29 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str47, "cp861"}
+  };
+
+#ifdef __GNUC__
+__inline
+#ifdef __GNUC_STDC_INLINE__
+__attribute__ ((__gnu_inline__))
+#endif
+#endif
+const struct mapping *
+mapping_lookup (register const char *str, register unsigned int len)
+{
+  if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH)
+    {
+      register int key = mapping_hash (str, len);
+
+      if (key <= MAX_HASH_VALUE && key >= 0)
+        {
+          register int o = mappings[key].standard_name;
+          if (o >= 0)
+            {
+              register const char *s = o + stringpool;
+
+              if (*str == *s && !strcmp (str + 1, s + 1))
+                return &mappings[key];
+            }
+        }
+    }
+  return 0;
+}
diff --git a/lib/iconv_open.c b/lib/iconv_open.c
new file mode 100644
index 000000000..3d873acd6
--- /dev/null
+++ b/lib/iconv_open.c
@@ -0,0 +1,172 @@
+/* Character set conversion.
+   Copyright (C) 2007 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 2, 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, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <iconv.h>
+
+#include <errno.h>
+#include <string.h>
+#include "c-ctype.h"
+#include "c-strcase.h"
+
+#define SIZEOF(a) (sizeof(a) / sizeof(a[0]))
+
+/* Namespace cleanliness.  */
+#define mapping_lookup rpl_iconv_open_mapping_lookup
+
+/* The macro ICONV_FLAVOR is defined to one of these or undefined.  */
+
+#define ICONV_FLAVOR_AIX "iconv_open-aix.h"
+#define ICONV_FLAVOR_HPUX "iconv_open-hpux.h"
+#define ICONV_FLAVOR_IRIX "iconv_open-irix.h"
+#define ICONV_FLAVOR_OSF "iconv_open-osf.h"
+
+#ifdef ICONV_FLAVOR
+# include ICONV_FLAVOR
+#endif
+
+iconv_t
+rpl_iconv_open (const char *tocode, const char *fromcode)
+#undef iconv_open
+{
+  char fromcode_upper[32];
+  char tocode_upper[32];
+  char *fromcode_upper_end;
+  char *tocode_upper_end;
+
+#if REPLACE_ICONV_UTF
+  /* Special handling of conversion between UTF-8 and UTF-{16,32}{BE,LE}.
+     Do this here, before calling the real iconv_open(), because  OSF/1 5.1
+     iconv() to these encoding inserts a BOM, which is wrong.
+     We do not need to handle conversion between arbitrary encodings and
+     UTF-{16,32}{BE,LE}, because the 'striconveh' module implements two-step
+     conversion throough UTF-8.
+     The _ICONV_* constants are chosen to be disjoint from any iconv_t
+     returned by the system's iconv_open() functions.  Recall that iconv_t
+     is a scalar type.  */
+  if (c_toupper (fromcode[0]) == 'U'
+      && c_toupper (fromcode[1]) == 'T'
+      && c_toupper (fromcode[2]) == 'F'
+      && fromcode[3] == '-')
+    {
+      if (c_toupper (tocode[0]) == 'U'
+	  && c_toupper (tocode[1]) == 'T'
+	  && c_toupper (tocode[2]) == 'F'
+	  && tocode[3] == '-')
+	{
+	  if (strcmp (fromcode + 4, "8") == 0)
+	    {
+	      if (c_strcasecmp (tocode + 4, "16BE") == 0)
+		return _ICONV_UTF8_UTF16BE;
+	      if (c_strcasecmp (tocode + 4, "16LE") == 0)
+		return _ICONV_UTF8_UTF16LE;
+	      if (c_strcasecmp (tocode + 4, "32BE") == 0)
+		return _ICONV_UTF8_UTF32BE;
+	      if (c_strcasecmp (tocode + 4, "32LE") == 0)
+		return _ICONV_UTF8_UTF32LE;
+	    }
+	  else if (strcmp (tocode + 4, "8") == 0)
+	    {
+	      if (c_strcasecmp (fromcode + 4, "16BE") == 0)
+		return _ICONV_UTF16BE_UTF8;
+	      if (c_strcasecmp (fromcode + 4, "16LE") == 0)
+		return _ICONV_UTF16LE_UTF8;
+	      if (c_strcasecmp (fromcode + 4, "32BE") == 0)
+		return _ICONV_UTF32BE_UTF8;
+	      if (c_strcasecmp (fromcode + 4, "32LE") == 0)
+		return _ICONV_UTF32LE_UTF8;
+	    }
+	}
+    }
+#endif
+
+  /* Do *not* add special support for 8-bit encodings like ASCII or ISO-8859-1
+     here.  This would lead to programs that work in some locales (such as the
+     "C" or "en_US" locales) but do not work in East Asian locales.  It is
+     better if programmers make their programs depend on GNU libiconv (except
+     on glibc systems), e.g. by using the AM_ICONV macro and documenting the
+     dependency in an INSTALL or DEPENDENCIES file.  */
+
+  /* Try with the original names first.
+     This covers the case when fromcode or tocode is a lowercase encoding name
+     that is understood by the system's iconv_open but not listed in our
+     mappings table.  */
+  {
+    iconv_t cd = iconv_open (tocode, fromcode);
+    if (cd != (iconv_t)(-1))
+      return cd;
+  }
+
+  /* Convert the encodings to upper case, because
+       1. in the arguments of iconv_open() on AIX, HP-UX, and OSF/1 the case
+	  matters,
+       2. it makes searching in the table faster.  */
+  {
+    const char *p = fromcode;
+    char *q = fromcode_upper;
+    while ((*q = c_toupper (*p)) != '\0')
+      {
+	p++;
+	q++;
+	if (q == &fromcode_upper[SIZEOF (fromcode_upper)])
+	  {
+	    errno = EINVAL;
+	    return (iconv_t)(-1);
+	  }
+      }
+    fromcode_upper_end = q;
+  }
+
+  {
+    const char *p = tocode;
+    char *q = tocode_upper;
+    while ((*q = c_toupper (*p)) != '\0')
+      {
+	p++;
+	q++;
+	if (q == &tocode_upper[SIZEOF (tocode_upper)])
+	  {
+	    errno = EINVAL;
+	    return (iconv_t)(-1);
+	  }
+      }
+    tocode_upper_end = q;
+  }
+
+#ifdef ICONV_FLAVOR
+  /* Apply the mappings.  */
+  {
+    const struct mapping *m =
+      mapping_lookup (fromcode_upper, fromcode_upper_end - fromcode_upper);
+
+    fromcode = (m != NULL ? m->vendor_name : fromcode_upper);
+  }
+  {
+    const struct mapping *m =
+      mapping_lookup (tocode_upper, tocode_upper_end - tocode_upper);
+
+    tocode = (m != NULL ? m->vendor_name : tocode_upper);
+  }
+#else
+  fromcode = fromcode_upper;
+  tocode = tocode_upper;
+#endif
+
+  return iconv_open (tocode, fromcode);
+}
diff --git a/lib/iconveh.h b/lib/iconveh.h
new file mode 100644
index 000000000..06cda52e8
--- /dev/null
+++ b/lib/iconveh.h
@@ -0,0 +1,41 @@
+/* Character set conversion handler type.
+   Copyright (C) 2001-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _ICONVEH_H
+#define _ICONVEH_H
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Handling of unconvertible characters.  */
+enum iconv_ilseq_handler
+{
+  iconveh_error,		/* return and set errno = EILSEQ */
+  iconveh_question_mark,	/* use one '?' per unconvertible character */
+  iconveh_escape_sequence	/* use escape sequence \uxxxx or \Uxxxxxxxx */
+};
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* _ICONVEH_H */
diff --git a/lib/striconveh.c b/lib/striconveh.c
new file mode 100644
index 000000000..b39a01f19
--- /dev/null
+++ b/lib/striconveh.c
@@ -0,0 +1,1251 @@
+/* Character set conversion with error handling.
+   Copyright (C) 2001-2008 Free Software Foundation, Inc.
+   Written by Bruno Haible and Simon Josefsson.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "striconveh.h"
+
+#include <errno.h>
+#include <stdbool.h>
+#include <stdlib.h>
+#include <string.h>
+
+#if HAVE_ICONV
+# include <iconv.h>
+# include "unistr.h"
+#endif
+
+#include "c-strcase.h"
+#include "c-strcaseeq.h"
+
+#ifndef SIZE_MAX
+# define SIZE_MAX ((size_t) -1)
+#endif
+
+
+#if HAVE_ICONV
+
+/* The caller must provide CD, CD1, CD2, not just CD, because when a conversion
+   error occurs, we may have to determine the Unicode representation of the
+   inconvertible character.  */
+
+/* iconv_carefully is like iconv, except that it stops as soon as it encounters
+   a conversion error, and it returns in *INCREMENTED a boolean telling whether
+   it has incremented the input pointers past the error location.  */
+# if !defined _LIBICONV_VERSION && !defined __GLIBC__
+/* Irix iconv() inserts a NUL byte if it cannot convert.
+   NetBSD iconv() inserts a question mark if it cannot convert.
+   Only GNU libiconv and GNU libc are known to prefer to fail rather
+   than doing a lossy conversion.  */
+static size_t
+iconv_carefully (iconv_t cd,
+		 const char **inbuf, size_t *inbytesleft,
+		 char **outbuf, size_t *outbytesleft,
+		 bool *incremented)
+{
+  const char *inptr = *inbuf;
+  const char *inptr_end = inptr + *inbytesleft;
+  char *outptr = *outbuf;
+  size_t outsize = *outbytesleft;
+  const char *inptr_before;
+  size_t res;
+
+  do
+    {
+      size_t insize;
+
+      inptr_before = inptr;
+      res = (size_t)(-1);
+
+      for (insize = 1; inptr + insize <= inptr_end; insize++)
+	{
+	  res = iconv (cd,
+		       (ICONV_CONST char **) &inptr, &insize,
+		       &outptr, &outsize);
+	  if (!(res == (size_t)(-1) && errno == EINVAL))
+	    break;
+	  /* iconv can eat up a shift sequence but give EINVAL while attempting
+	     to convert the first character.  E.g. libiconv does this.  */
+	  if (inptr > inptr_before)
+	    {
+	      res = 0;
+	      break;
+	    }
+	}
+
+      if (res == 0)
+	{
+	  *outbuf = outptr;
+	  *outbytesleft = outsize;
+	}
+    }
+  while (res == 0 && inptr < inptr_end);
+
+  *inbuf = inptr;
+  *inbytesleft = inptr_end - inptr;
+  if (res != (size_t)(-1) && res > 0)
+    {
+      /* iconv() has already incremented INPTR.  We cannot go back to a
+	 previous INPTR, otherwise the state inside CD would become invalid,
+	 if FROM_CODESET is a stateful encoding.  So, tell the caller that
+	 *INBUF has already been incremented.  */
+      *incremented = (inptr > inptr_before);
+      errno = EILSEQ;
+      return (size_t)(-1);
+    }
+  else
+    {
+      *incremented = false;
+      return res;
+    }
+}
+# else
+#  define iconv_carefully(cd, inbuf, inbytesleft, outbuf, outbytesleft, incremented) \
+     (*(incremented) = false, \
+      iconv (cd, (ICONV_CONST char **) (inbuf), inbytesleft, outbuf, outbytesleft))
+# endif
+
+/* iconv_carefully_1 is like iconv_carefully, except that it stops after
+   converting one character or one shift sequence.  */
+static size_t
+iconv_carefully_1 (iconv_t cd,
+		   const char **inbuf, size_t *inbytesleft,
+		   char **outbuf, size_t *outbytesleft,
+		   bool *incremented)
+{
+  const char *inptr_before = *inbuf;
+  const char *inptr = inptr_before;
+  const char *inptr_end = inptr_before + *inbytesleft;
+  char *outptr = *outbuf;
+  size_t outsize = *outbytesleft;
+  size_t res = (size_t)(-1);
+  size_t insize;
+
+  for (insize = 1; inptr_before + insize <= inptr_end; insize++)
+    {
+      inptr = inptr_before;
+      res = iconv (cd,
+		   (ICONV_CONST char **) &inptr, &insize,
+		   &outptr, &outsize);
+      if (!(res == (size_t)(-1) && errno == EINVAL))
+	break;
+      /* iconv can eat up a shift sequence but give EINVAL while attempting
+	 to convert the first character.  E.g. libiconv does this.  */
+      if (inptr > inptr_before)
+	{
+	  res = 0;
+	  break;
+	}
+    }
+
+  *inbuf = inptr;
+  *inbytesleft = inptr_end - inptr;
+# if !defined _LIBICONV_VERSION && !defined __GLIBC__
+  /* Irix iconv() inserts a NUL byte if it cannot convert.
+     NetBSD iconv() inserts a question mark if it cannot convert.
+     Only GNU libiconv and GNU libc are known to prefer to fail rather
+     than doing a lossy conversion.  */
+  if (res != (size_t)(-1) && res > 0)
+    {
+      /* iconv() has already incremented INPTR.  We cannot go back to a
+	 previous INPTR, otherwise the state inside CD would become invalid,
+	 if FROM_CODESET is a stateful encoding.  So, tell the caller that
+	 *INBUF has already been incremented.  */
+      *incremented = (inptr > inptr_before);
+      errno = EILSEQ;
+      return (size_t)(-1);
+    }
+# endif
+
+  if (res != (size_t)(-1))
+    {
+      *outbuf = outptr;
+      *outbytesleft = outsize;
+    }
+  *incremented = false;
+  return res;
+}
+
+/* utf8conv_carefully is like iconv, except that
+     - it converts from UTF-8 to UTF-8,
+     - it stops as soon as it encounters a conversion error, and it returns
+       in *INCREMENTED a boolean telling whether it has incremented the input
+       pointers past the error location,
+     - if one_character_only is true, it stops after converting one
+       character.  */
+static size_t
+utf8conv_carefully (bool one_character_only,
+		    const char **inbuf, size_t *inbytesleft,
+		    char **outbuf, size_t *outbytesleft,
+		    bool *incremented)
+{
+  const char *inptr = *inbuf;
+  size_t insize = *inbytesleft;
+  char *outptr = *outbuf;
+  size_t outsize = *outbytesleft;
+  size_t res;
+
+  res = 0;
+  do
+    {
+      ucs4_t uc;
+      int n;
+      int m;
+
+      n = u8_mbtoucr (&uc, (const uint8_t *) inptr, insize);
+      if (n < 0)
+	{
+	  errno = (n == -2 ? EINVAL : EILSEQ);
+	  n = u8_mbtouc (&uc, (const uint8_t *) inptr, insize);
+	  inptr += n;
+	  insize -= n;
+	  res = (size_t)(-1);
+	  *incremented = true;
+	  break;
+	}
+      if (outsize == 0)
+	{
+	  errno = E2BIG;
+	  res = (size_t)(-1);
+	  *incremented = false;
+	  break;
+	}
+      m = u8_uctomb ((uint8_t *) outptr, uc, outsize);
+      if (m == -2)
+	{
+	  errno = E2BIG;
+	  res = (size_t)(-1);
+	  *incremented = false;
+	  break;
+	}
+      inptr += n;
+      insize -= n;
+      if (m == -1)
+	{
+	  errno = EILSEQ;
+	  res = (size_t)(-1);
+	  *incremented = true;
+	  break;
+	}
+      outptr += m;
+      outsize -= m;
+    }
+  while (!one_character_only && insize > 0);
+
+  *inbuf = inptr;
+  *inbytesleft = insize;
+  *outbuf = outptr;
+  *outbytesleft = outsize;
+  return res;
+}
+
+static int
+mem_cd_iconveh_internal (const char *src, size_t srclen,
+			 iconv_t cd, iconv_t cd1, iconv_t cd2,
+			 enum iconv_ilseq_handler handler,
+			 size_t extra_alloc,
+			 size_t *offsets,
+			 char **resultp, size_t *lengthp)
+{
+  /* When a conversion error occurs, we cannot start using CD1 and CD2 at
+     this point: FROM_CODESET may be a stateful encoding like ISO-2022-KR.
+     Instead, we have to start afresh from the beginning of SRC.  */
+  /* Use a temporary buffer, so that for small strings, a single malloc()
+     call will be sufficient.  */
+# define tmpbufsize 4096
+  /* The alignment is needed when converting e.g. to glibc's WCHAR_T or
+     libiconv's UCS-4-INTERNAL encoding.  */
+  union { unsigned int align; char buf[tmpbufsize]; } tmp;
+# define tmpbuf tmp.buf
+
+  char *initial_result;
+  char *result;
+  size_t allocated;
+  size_t length;
+  size_t last_length = (size_t)(-1); /* only needed if offsets != NULL */
+
+  if (*resultp != NULL && *lengthp >= sizeof (tmpbuf))
+    {
+      initial_result = *resultp;
+      allocated = *lengthp;
+    }
+  else
+    {
+      initial_result = tmpbuf;
+      allocated = sizeof (tmpbuf);
+    }
+  result = initial_result;
+
+  /* Test whether a direct conversion is possible at all.  */
+  if (cd == (iconv_t)(-1))
+    goto indirectly;
+
+  if (offsets != NULL)
+    {
+      size_t i;
+
+      for (i = 0; i < srclen; i++)
+	offsets[i] = (size_t)(-1);
+
+      last_length = (size_t)(-1);
+    }
+  length = 0;
+
+  /* First, try a direct conversion, and see whether a conversion error
+     occurs at all.  */
+  {
+    const char *inptr = src;
+    size_t insize = srclen;
+
+    /* Avoid glibc-2.1 bug and Solaris 2.7-2.9 bug.  */
+# if defined _LIBICONV_VERSION \
+     || !((__GLIBC__ - 0 == 2 && __GLIBC_MINOR__ - 0 <= 1) || defined __sun)
+    /* Set to the initial state.  */
+    iconv (cd, NULL, NULL, NULL, NULL);
+# endif
+
+    while (insize > 0)
+      {
+	char *outptr = result + length;
+	size_t outsize = allocated - extra_alloc - length;
+	bool incremented;
+	size_t res;
+	bool grow;
+
+	if (offsets != NULL)
+	  {
+	    if (length != last_length) /* ensure that offset[] be increasing */
+	      {
+		offsets[inptr - src] = length;
+		last_length = length;
+	      }
+	    res = iconv_carefully_1 (cd,
+				     &inptr, &insize,
+				     &outptr, &outsize,
+				     &incremented);
+	  }
+	else
+	  /* Use iconv_carefully instead of iconv here, because:
+	     - If TO_CODESET is UTF-8, we can do the error handling in this
+	       loop, no need for a second loop,
+	     - With iconv() implementations other than GNU libiconv and GNU
+	       libc, if we use iconv() in a big swoop, checking for an E2BIG
+	       return, we lose the number of irreversible conversions.  */
+	  res = iconv_carefully (cd,
+				 &inptr, &insize,
+				 &outptr, &outsize,
+				 &incremented);
+
+	length = outptr - result;
+	grow = (length + extra_alloc > allocated / 2);
+	if (res == (size_t)(-1))
+	  {
+	    if (errno == E2BIG)
+	      grow = true;
+	    else if (errno == EINVAL)
+	      break;
+	    else if (errno == EILSEQ && handler != iconveh_error)
+	      {
+		if (cd2 == (iconv_t)(-1))
+		  {
+		    /* TO_CODESET is UTF-8.  */
+		    /* Error handling can produce up to 1 byte of output.  */
+		    if (length + 1 + extra_alloc > allocated)
+		      {
+			char *memory;
+
+			allocated = 2 * allocated;
+			if (length + 1 + extra_alloc > allocated)
+			  abort ();
+			if (result == initial_result)
+			  memory = (char *) malloc (allocated);
+			else
+			  memory = (char *) realloc (result, allocated);
+			if (memory == NULL)
+			  {
+			    if (result != initial_result)
+			      free (result);
+			    errno = ENOMEM;
+			    return -1;
+			  }
+			if (result == initial_result)
+			  memcpy (memory, initial_result, length);
+			result = memory;
+			grow = false;
+		      }
+		    /* The input is invalid in FROM_CODESET.  Eat up one byte
+		       and emit a question mark.  */
+		    if (!incremented)
+		      {
+			if (insize == 0)
+			  abort ();
+			inptr++;
+			insize--;
+		      }
+		    result[length] = '?';
+		    length++;
+		  }
+		else
+		  goto indirectly;
+	      }
+	    else
+	      {
+		if (result != initial_result)
+		  {
+		    int saved_errno = errno;
+		    free (result);
+		    errno = saved_errno;
+		  }
+		return -1;
+	      }
+	  }
+	if (insize == 0)
+	  break;
+	if (grow)
+	  {
+	    char *memory;
+
+	    allocated = 2 * allocated;
+	    if (result == initial_result)
+	      memory = (char *) malloc (allocated);
+	    else
+	      memory = (char *) realloc (result, allocated);
+	    if (memory == NULL)
+	      {
+		if (result != initial_result)
+		  free (result);
+		errno = ENOMEM;
+		return -1;
+	      }
+	    if (result == initial_result)
+	      memcpy (memory, initial_result, length);
+	    result = memory;
+	  }
+      }
+  }
+
+  /* Now get the conversion state back to the initial state.
+     But avoid glibc-2.1 bug and Solaris 2.7 bug.  */
+#if defined _LIBICONV_VERSION \
+    || !((__GLIBC__ == 2 && __GLIBC_MINOR__ <= 1) || defined __sun)
+  for (;;)
+    {
+      char *outptr = result + length;
+      size_t outsize = allocated - extra_alloc - length;
+      size_t res;
+
+      res = iconv (cd, NULL, NULL, &outptr, &outsize);
+      length = outptr - result;
+      if (res == (size_t)(-1))
+	{
+	  if (errno == E2BIG)
+	    {
+	      char *memory;
+
+	      allocated = 2 * allocated;
+	      if (result == initial_result)
+		memory = (char *) malloc (allocated);
+	      else
+		memory = (char *) realloc (result, allocated);
+	      if (memory == NULL)
+		{
+		  if (result != initial_result)
+		    free (result);
+		  errno = ENOMEM;
+		  return -1;
+		}
+	      if (result == initial_result)
+		memcpy (memory, initial_result, length);
+	      result = memory;
+	    }
+	  else
+	    {
+	      if (result != initial_result)
+		{
+		  int saved_errno = errno;
+		  free (result);
+		  errno = saved_errno;
+		}
+	      return -1;
+	    }
+	}
+      else
+	break;
+    }
+#endif
+
+  /* The direct conversion succeeded.  */
+  goto done;
+
+ indirectly:
+  /* The direct conversion failed.
+     Use a conversion through UTF-8.  */
+  if (offsets != NULL)
+    {
+      size_t i;
+
+      for (i = 0; i < srclen; i++)
+	offsets[i] = (size_t)(-1);
+
+      last_length = (size_t)(-1);
+    }
+  length = 0;
+  {
+    const bool slowly = (offsets != NULL || handler == iconveh_error);
+# define utf8bufsize 4096 /* may also be smaller or larger than tmpbufsize */
+    char utf8buf[utf8bufsize + 1];
+    size_t utf8len = 0;
+    const char *in1ptr = src;
+    size_t in1size = srclen;
+    bool do_final_flush1 = true;
+    bool do_final_flush2 = true;
+
+    /* Avoid glibc-2.1 bug and Solaris 2.7-2.9 bug.  */
+# if defined _LIBICONV_VERSION \
+     || !((__GLIBC__ - 0 == 2 && __GLIBC_MINOR__ - 0 <= 1) || defined __sun)
+    /* Set to the initial state.  */
+    if (cd1 != (iconv_t)(-1))
+      iconv (cd1, NULL, NULL, NULL, NULL);
+    if (cd2 != (iconv_t)(-1))
+      iconv (cd2, NULL, NULL, NULL, NULL);
+# endif
+
+    while (in1size > 0 || do_final_flush1 || utf8len > 0 || do_final_flush2)
+      {
+	char *out1ptr = utf8buf + utf8len;
+	size_t out1size = utf8bufsize - utf8len;
+	bool incremented1;
+	size_t res1;
+	int errno1;
+
+	/* Conversion step 1: from FROM_CODESET to UTF-8.  */
+	if (in1size > 0)
+	  {
+	    if (offsets != NULL
+		&& length != last_length) /* ensure that offset[] be increasing */
+	      {
+		offsets[in1ptr - src] = length;
+		last_length = length;
+	      }
+	    if (cd1 != (iconv_t)(-1))
+	      {
+		if (slowly)
+		  res1 = iconv_carefully_1 (cd1,
+					    &in1ptr, &in1size,
+					    &out1ptr, &out1size,
+					    &incremented1);
+		else
+		  res1 = iconv_carefully (cd1,
+					  &in1ptr, &in1size,
+					  &out1ptr, &out1size,
+					  &incremented1);
+	      }
+	    else
+	      {
+		/* FROM_CODESET is UTF-8.  */
+		res1 = utf8conv_carefully (slowly,
+					   &in1ptr, &in1size,
+					   &out1ptr, &out1size,
+					   &incremented1);
+	      }
+	  }
+	else if (do_final_flush1)
+	  {
+	    /* Now get the conversion state of CD1 back to the initial state.
+	       But avoid glibc-2.1 bug and Solaris 2.7 bug.  */
+# if defined _LIBICONV_VERSION \
+     || !((__GLIBC__ == 2 && __GLIBC_MINOR__ <= 1) || defined __sun)
+	    if (cd1 != (iconv_t)(-1))
+	      res1 = iconv (cd1, NULL, NULL, &out1ptr, &out1size);
+	    else
+# endif
+	      res1 = 0;
+	    do_final_flush1 = false;
+	    incremented1 = true;
+	  }
+	else
+	  {
+	    res1 = 0;
+	    incremented1 = true;
+	  }
+	if (res1 == (size_t)(-1)
+	    && !(errno == E2BIG || errno == EINVAL || errno == EILSEQ))
+	  {
+	    if (result != initial_result)
+	      {
+		int saved_errno = errno;
+		free (result);
+		errno = saved_errno;
+	      }
+	    return -1;
+	  }
+	if (res1 == (size_t)(-1)
+	    && errno == EILSEQ && handler != iconveh_error)
+	  {
+	    /* The input is invalid in FROM_CODESET.  Eat up one byte and
+	       emit a question mark.  Room for the question mark was allocated
+	       at the end of utf8buf.  */
+	    if (!incremented1)
+	      {
+		if (in1size == 0)
+		  abort ();
+		in1ptr++;
+		in1size--;
+	      }
+	    utf8buf[utf8len++] = '?';
+	  }
+	errno1 = errno;
+	utf8len = out1ptr - utf8buf;
+
+	if (offsets != NULL
+	    || in1size == 0
+	    || utf8len > utf8bufsize / 2
+	    || (res1 == (size_t)(-1) && errno1 == E2BIG))
+	  {
+	    /* Conversion step 2: from UTF-8 to TO_CODESET.  */
+	    const char *in2ptr = utf8buf;
+	    size_t in2size = utf8len;
+
+	    while (in2size > 0
+		   || (in1size == 0 && !do_final_flush1 && do_final_flush2))
+	      {
+		char *out2ptr = result + length;
+		size_t out2size = allocated - extra_alloc - length;
+		bool incremented2;
+		size_t res2;
+		bool grow;
+
+		if (in2size > 0)
+		  {
+		    if (cd2 != (iconv_t)(-1))
+		      res2 = iconv_carefully (cd2,
+					      &in2ptr, &in2size,
+					      &out2ptr, &out2size,
+					      &incremented2);
+		    else
+		      /* TO_CODESET is UTF-8.  */
+		      res2 = utf8conv_carefully (false,
+						 &in2ptr, &in2size,
+						 &out2ptr, &out2size,
+						 &incremented2);
+		  }
+		else /* in1size == 0 && !do_final_flush1
+			&& in2size == 0 && do_final_flush2 */
+		  {
+		    /* Now get the conversion state of CD1 back to the initial
+		       state.  But avoid glibc-2.1 bug and Solaris 2.7 bug.  */
+# if defined _LIBICONV_VERSION \
+     || !((__GLIBC__ == 2 && __GLIBC_MINOR__ <= 1) || defined __sun)
+		    if (cd2 != (iconv_t)(-1))
+		      res2 = iconv (cd2, NULL, NULL, &out2ptr, &out2size);
+		    else
+# endif
+		      res2 = 0;
+		    do_final_flush2 = false;
+		    incremented2 = true;
+		  }
+
+		length = out2ptr - result;
+		grow = (length + extra_alloc > allocated / 2);
+		if (res2 == (size_t)(-1))
+		  {
+		    if (errno == E2BIG)
+		      grow = true;
+		    else if (errno == EINVAL)
+		      break;
+		    else if (errno == EILSEQ && handler != iconveh_error)
+		      {
+			/* Error handling can produce up to 10 bytes of ASCII
+			   output.  But TO_CODESET may be UCS-2, UTF-16 or
+			   UCS-4, so use CD2 here as well.  */
+			char scratchbuf[10];
+			size_t scratchlen;
+			ucs4_t uc;
+			const char *inptr;
+			size_t insize;
+			size_t res;
+
+			if (incremented2)
+			  {
+			    if (u8_prev (&uc, (const uint8_t *) in2ptr,
+					 (const uint8_t *) utf8buf)
+				== NULL)
+			      abort ();
+			  }
+			else
+			  {
+			    int n;
+			    if (in2size == 0)
+			      abort ();
+			    n = u8_mbtouc_unsafe (&uc, (const uint8_t *) in2ptr,
+						  in2size);
+			    in2ptr += n;
+			    in2size -= n;
+			  }
+
+			if (handler == iconveh_escape_sequence)
+			  {
+			    static char hex[16] = "0123456789ABCDEF";
+			    scratchlen = 0;
+			    scratchbuf[scratchlen++] = '\\';
+			    if (uc < 0x10000)
+			      scratchbuf[scratchlen++] = 'u';
+			    else
+			      {
+				scratchbuf[scratchlen++] = 'U';
+				scratchbuf[scratchlen++] = hex[(uc>>28) & 15];
+				scratchbuf[scratchlen++] = hex[(uc>>24) & 15];
+				scratchbuf[scratchlen++] = hex[(uc>>20) & 15];
+				scratchbuf[scratchlen++] = hex[(uc>>16) & 15];
+			      }
+			    scratchbuf[scratchlen++] = hex[(uc>>12) & 15];
+			    scratchbuf[scratchlen++] = hex[(uc>>8) & 15];
+			    scratchbuf[scratchlen++] = hex[(uc>>4) & 15];
+			    scratchbuf[scratchlen++] = hex[uc & 15];
+			  }
+			else
+			  {
+			    scratchbuf[0] = '?';
+			    scratchlen = 1;
+			  }
+
+			inptr = scratchbuf;
+			insize = scratchlen;
+			if (cd2 != (iconv_t)(-1))
+			  res = iconv (cd2,
+				       (ICONV_CONST char **) &inptr, &insize,
+				       &out2ptr, &out2size);
+			else
+			  {
+			    /* TO_CODESET is UTF-8.  */
+			    if (out2size >= insize)
+			      {
+				memcpy (out2ptr, inptr, insize);
+				out2ptr += insize;
+				out2size -= insize;
+				inptr += insize;
+				insize = 0;
+				res = 0;
+			      }
+			    else
+			      {
+				errno = E2BIG;
+				res = (size_t)(-1);
+			      }
+			  }
+			length = out2ptr - result;
+			if (res == (size_t)(-1) && errno == E2BIG)
+			  {
+			    char *memory;
+
+			    allocated = 2 * allocated;
+			    if (length + 1 + extra_alloc > allocated)
+			      abort ();
+			    if (result == initial_result)
+			      memory = (char *) malloc (allocated);
+			    else
+			      memory = (char *) realloc (result, allocated);
+			    if (memory == NULL)
+			      {
+				if (result != initial_result)
+				  free (result);
+				errno = ENOMEM;
+				return -1;
+			      }
+			    if (result == initial_result)
+			      memcpy (memory, initial_result, length);
+			    result = memory;
+			    grow = false;
+
+			    out2ptr = result + length;
+			    out2size = allocated - extra_alloc - length;
+			    if (cd2 != (iconv_t)(-1))
+			      res = iconv (cd2,
+					   (ICONV_CONST char **) &inptr,
+					   &insize,
+					   &out2ptr, &out2size);
+			    else
+			      {
+				/* TO_CODESET is UTF-8.  */
+				if (!(out2size >= insize))
+				  abort ();
+				memcpy (out2ptr, inptr, insize);
+				out2ptr += insize;
+				out2size -= insize;
+				inptr += insize;
+				insize = 0;
+				res = 0;
+			      }
+			    length = out2ptr - result;
+			  }
+# if !defined _LIBICONV_VERSION && !defined __GLIBC__
+			/* Irix iconv() inserts a NUL byte if it cannot convert.
+			   NetBSD iconv() inserts a question mark if it cannot
+			   convert.
+			   Only GNU libiconv and GNU libc are known to prefer
+			   to fail rather than doing a lossy conversion.  */
+			if (res != (size_t)(-1) && res > 0)
+			  {
+			    errno = EILSEQ;
+			    res = (size_t)(-1);
+			  }
+# endif
+			if (res == (size_t)(-1))
+			  {
+			    /* Failure converting the ASCII replacement.  */
+			    if (result != initial_result)
+			      {
+				int saved_errno = errno;
+				free (result);
+				errno = saved_errno;
+			      }
+			    return -1;
+			  }
+		      }
+		    else
+		      {
+			if (result != initial_result)
+			  {
+			    int saved_errno = errno;
+			    free (result);
+			    errno = saved_errno;
+			  }
+			return -1;
+		      }
+		  }
+		if (!(in2size > 0
+		      || (in1size == 0 && !do_final_flush1 && do_final_flush2)))
+		  break;
+		if (grow)
+		  {
+		    char *memory;
+
+		    allocated = 2 * allocated;
+		    if (result == initial_result)
+		      memory = (char *) malloc (allocated);
+		    else
+		      memory = (char *) realloc (result, allocated);
+		    if (memory == NULL)
+		      {
+			if (result != initial_result)
+			  free (result);
+			errno = ENOMEM;
+			return -1;
+		      }
+		    if (result == initial_result)
+		      memcpy (memory, initial_result, length);
+		    result = memory;
+		  }
+	      }
+
+	    /* Move the remaining bytes to the beginning of utf8buf.  */
+	    if (in2size > 0)
+	      memmove (utf8buf, in2ptr, in2size);
+	    utf8len = in2size;
+	  }
+
+	if (res1 == (size_t)(-1))
+	  {
+	    if (errno1 == EINVAL)
+	      in1size = 0;
+	    else if (errno1 == EILSEQ)
+	      {
+		if (result != initial_result)
+		  free (result);
+		errno = errno1;
+		return -1;
+	      }
+	  }
+      }
+# undef utf8bufsize
+  }
+
+ done:
+  /* Now the final memory allocation.  */
+  if (result == tmpbuf)
+    {
+      size_t memsize = length + extra_alloc;
+      char *memory;
+
+      memory = (char *) malloc (memsize > 0 ? memsize : 1);
+      if (memory != NULL)
+	{
+	  memcpy (memory, tmpbuf, length);
+	  result = memory;
+	}
+      else
+	{
+	  errno = ENOMEM;
+	  return -1;
+        }
+    }
+  else if (result != *resultp && length + extra_alloc < allocated)
+    {
+      /* Shrink the allocated memory if possible.  */
+      size_t memsize = length + extra_alloc;
+      char *memory;
+
+      memory = (char *) realloc (result, memsize > 0 ? memsize : 1);
+      if (memory != NULL)
+	result = memory;
+    }
+  *resultp = result;
+  *lengthp = length;
+  return 0;
+# undef tmpbuf
+# undef tmpbufsize
+}
+
+int
+mem_cd_iconveh (const char *src, size_t srclen,
+		iconv_t cd, iconv_t cd1, iconv_t cd2,
+		enum iconv_ilseq_handler handler,
+		size_t *offsets,
+		char **resultp, size_t *lengthp)
+{
+  return mem_cd_iconveh_internal (src, srclen, cd, cd1, cd2, handler, 0,
+				  offsets, resultp, lengthp);
+}
+
+char *
+str_cd_iconveh (const char *src,
+		iconv_t cd, iconv_t cd1, iconv_t cd2,
+		enum iconv_ilseq_handler handler)
+{
+  /* For most encodings, a trailing NUL byte in the input will be converted
+     to a trailing NUL byte in the output.  But not for UTF-7.  So that this
+     function is usable for UTF-7, we have to exclude the NUL byte from the
+     conversion and add it by hand afterwards.  */
+  char *result = NULL;
+  size_t length = 0;
+  int retval = mem_cd_iconveh_internal (src, strlen (src),
+					cd, cd1, cd2, handler, 1, NULL,
+					&result, &length);
+
+  if (retval < 0)
+    {
+      if (result != NULL)
+	{
+	  int saved_errno = errno;
+	  free (result);
+	  errno = saved_errno;
+	}
+      return NULL;
+    }
+
+  /* Add the terminating NUL byte.  */
+  result[length] = '\0';
+
+  return result;
+}
+
+#endif
+
+int
+mem_iconveh (const char *src, size_t srclen,
+	     const char *from_codeset, const char *to_codeset,
+	     enum iconv_ilseq_handler handler,
+	     size_t *offsets,
+	     char **resultp, size_t *lengthp)
+{
+  if (srclen == 0)
+    {
+      /* Nothing to convert.  */
+      *lengthp = 0;
+      return 0;
+    }
+  else if (offsets == NULL && c_strcasecmp (from_codeset, to_codeset) == 0)
+    {
+      char *result;
+
+      if (*resultp != NULL && *lengthp >= srclen)
+	result = *resultp;
+      else
+	{
+	  result = (char *) malloc (srclen);
+	  if (result == NULL)
+	    {
+	      errno = ENOMEM;
+	      return -1;
+	    }
+	}
+      memcpy (result, src, srclen);
+      *resultp = result;
+      *lengthp = srclen;
+      return 0;
+    }
+  else
+    {
+#if HAVE_ICONV
+      iconv_t cd;
+      iconv_t cd1;
+      iconv_t cd2;
+      char *result;
+      size_t length;
+      int retval;
+
+      /* Avoid glibc-2.1 bug with EUC-KR.  */
+# if (__GLIBC__ - 0 == 2 && __GLIBC_MINOR__ - 0 <= 1) && !defined _LIBICONV_VERSION
+      if (c_strcasecmp (from_codeset, "EUC-KR") == 0
+	  || c_strcasecmp (to_codeset, "EUC-KR") == 0)
+	{
+	  errno = EINVAL;
+	  return -1;
+	}
+# endif
+
+      cd = iconv_open (to_codeset, from_codeset);
+
+      if (STRCASEEQ (from_codeset, "UTF-8", 'U','T','F','-','8',0,0,0,0))
+	cd1 = (iconv_t)(-1);
+      else
+	{
+	  cd1 = iconv_open ("UTF-8", from_codeset);
+	  if (cd1 == (iconv_t)(-1))
+	    {
+	      int saved_errno = errno;
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      errno = saved_errno;
+	      return -1;
+	    }
+	}
+
+      if (STRCASEEQ (to_codeset, "UTF-8", 'U','T','F','-','8',0,0,0,0)
+# if (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || __GLIBC__ > 2 || _LIBICONV_VERSION >= 0x0105
+	  || c_strcasecmp (to_codeset, "UTF-8//TRANSLIT") == 0
+# endif
+	 )
+	cd2 = (iconv_t)(-1);
+      else
+	{
+	  cd2 = iconv_open (to_codeset, "UTF-8");
+	  if (cd2 == (iconv_t)(-1))
+	    {
+	      int saved_errno = errno;
+	      if (cd1 != (iconv_t)(-1))
+		iconv_close (cd1);
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      errno = saved_errno;
+	      return -1;
+	    }
+	}
+
+      result = *resultp;
+      length = *lengthp;
+      retval = mem_cd_iconveh (src, srclen, cd, cd1, cd2, handler, offsets,
+			       &result, &length);
+
+      if (retval < 0)
+	{
+	  /* Close cd, cd1, cd2, but preserve the errno from str_cd_iconv.  */
+	  int saved_errno = errno;
+	  if (cd2 != (iconv_t)(-1))
+	    iconv_close (cd2);
+	  if (cd1 != (iconv_t)(-1))
+	    iconv_close (cd1);
+	  if (cd != (iconv_t)(-1))
+	    iconv_close (cd);
+	  errno = saved_errno;
+	}
+      else
+	{
+	  if (cd2 != (iconv_t)(-1) && iconv_close (cd2) < 0)
+	    {
+	      /* Return -1, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      if (cd1 != (iconv_t)(-1))
+		iconv_close (cd1);
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      if (result != *resultp && result != NULL)
+		free (result);
+	      errno = saved_errno;
+	      return -1;
+	    }
+	  if (cd1 != (iconv_t)(-1) && iconv_close (cd1) < 0)
+	    {
+	      /* Return -1, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      if (result != *resultp && result != NULL)
+		free (result);
+	      errno = saved_errno;
+	      return -1;
+	    }
+	  if (cd != (iconv_t)(-1) && iconv_close (cd) < 0)
+	    {
+	      /* Return -1, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      if (result != *resultp && result != NULL)
+		free (result);
+	      errno = saved_errno;
+	      return -1;
+	    }
+	  *resultp = result;
+	  *lengthp = length;
+	}
+      return retval;
+#else
+      /* This is a different error code than if iconv_open existed but didn't
+	 support from_codeset and to_codeset, so that the caller can emit
+	 an error message such as
+	   "iconv() is not supported. Installing GNU libiconv and
+	    then reinstalling this package would fix this."  */
+      errno = ENOSYS;
+      return -1;
+#endif
+    }
+}
+
+char *
+str_iconveh (const char *src,
+	     const char *from_codeset, const char *to_codeset,
+	     enum iconv_ilseq_handler handler)
+{
+  if (*src == '\0' || c_strcasecmp (from_codeset, to_codeset) == 0)
+    {
+      char *result = strdup (src);
+
+      if (result == NULL)
+	errno = ENOMEM;
+      return result;
+    }
+  else
+    {
+#if HAVE_ICONV
+      iconv_t cd;
+      iconv_t cd1;
+      iconv_t cd2;
+      char *result;
+
+      /* Avoid glibc-2.1 bug with EUC-KR.  */
+# if (__GLIBC__ - 0 == 2 && __GLIBC_MINOR__ - 0 <= 1) && !defined _LIBICONV_VERSION
+      if (c_strcasecmp (from_codeset, "EUC-KR") == 0
+	  || c_strcasecmp (to_codeset, "EUC-KR") == 0)
+	{
+	  errno = EINVAL;
+	  return NULL;
+	}
+# endif
+
+      cd = iconv_open (to_codeset, from_codeset);
+
+      if (STRCASEEQ (from_codeset, "UTF-8", 'U','T','F','-','8',0,0,0,0))
+	cd1 = (iconv_t)(-1);
+      else
+	{
+	  cd1 = iconv_open ("UTF-8", from_codeset);
+	  if (cd1 == (iconv_t)(-1))
+	    {
+	      int saved_errno = errno;
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      errno = saved_errno;
+	      return NULL;
+	    }
+	}
+
+      if (STRCASEEQ (to_codeset, "UTF-8", 'U','T','F','-','8',0,0,0,0)
+# if (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || __GLIBC__ > 2 || _LIBICONV_VERSION >= 0x0105
+	  || c_strcasecmp (to_codeset, "UTF-8//TRANSLIT") == 0
+# endif
+	 )
+	cd2 = (iconv_t)(-1);
+      else
+	{
+	  cd2 = iconv_open (to_codeset, "UTF-8");
+	  if (cd2 == (iconv_t)(-1))
+	    {
+	      int saved_errno = errno;
+	      if (cd1 != (iconv_t)(-1))
+		iconv_close (cd1);
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      errno = saved_errno;
+	      return NULL;
+	    }
+	}
+
+      result = str_cd_iconveh (src, cd, cd1, cd2, handler);
+
+      if (result == NULL)
+	{
+	  /* Close cd, cd1, cd2, but preserve the errno from str_cd_iconv.  */
+	  int saved_errno = errno;
+	  if (cd2 != (iconv_t)(-1))
+	    iconv_close (cd2);
+	  if (cd1 != (iconv_t)(-1))
+	    iconv_close (cd1);
+	  if (cd != (iconv_t)(-1))
+	    iconv_close (cd);
+	  errno = saved_errno;
+	}
+      else
+	{
+	  if (cd2 != (iconv_t)(-1) && iconv_close (cd2) < 0)
+	    {
+	      /* Return NULL, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      if (cd1 != (iconv_t)(-1))
+		iconv_close (cd1);
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      free (result);
+	      errno = saved_errno;
+	      return NULL;
+	    }
+	  if (cd1 != (iconv_t)(-1) && iconv_close (cd1) < 0)
+	    {
+	      /* Return NULL, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      free (result);
+	      errno = saved_errno;
+	      return NULL;
+	    }
+	  if (cd != (iconv_t)(-1) && iconv_close (cd) < 0)
+	    {
+	      /* Return NULL, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      free (result);
+	      errno = saved_errno;
+	      return NULL;
+	    }
+	}
+      return result;
+#else
+      /* This is a different error code than if iconv_open existed but didn't
+	 support from_codeset and to_codeset, so that the caller can emit
+	 an error message such as
+	   "iconv() is not supported. Installing GNU libiconv and
+	    then reinstalling this package would fix this."  */
+      errno = ENOSYS;
+      return NULL;
+#endif
+    }
+}
diff --git a/lib/striconveh.h b/lib/striconveh.h
new file mode 100644
index 000000000..98b4d0c5e
--- /dev/null
+++ b/lib/striconveh.h
@@ -0,0 +1,120 @@
+/* Character set conversion with error handling.
+   Copyright (C) 2001-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible and Simon Josefsson.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _STRICONVEH_H
+#define _STRICONVEH_H
+
+#include <stddef.h>
+#if HAVE_ICONV
+#include <iconv.h>
+#endif
+
+#include "iconveh.h"
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+#if HAVE_ICONV
+
+/* Convert an entire string from one encoding to another, using iconv.
+   The original string is at [SRC,...,SRC+SRCLEN-1].
+   CD is the conversion descriptor from FROMCODE to TOCODE, or (iconv_t)(-1) if
+   the system does not support a direct conversion from FROMCODE to TOCODE.
+   CD1 is the conversion descriptor from FROM_CODESET to UTF-8 (or
+   (iconv_t)(-1) if FROM_CODESET is UTF-8).
+   CD2 is the conversion descriptor from UTF-8 to TO_CODESET (or (iconv_t)(-1)
+   if TO_CODESET is UTF-8).
+   If OFFSETS is not NULL, it should point to an array of SRCLEN integers; this
+   array is filled with offsets into the result, i.e. the character starting
+   at SRC[i] corresponds to the character starting at (*RESULTP)[OFFSETS[i]],
+   and other offsets are set to (size_t)(-1).
+   *RESULTP and *LENGTH should initially be a scratch buffer and its size,
+   or *RESULTP can initially be NULL.
+   May erase the contents of the memory at *RESULTP.
+   Return value: 0 if successful, otherwise -1 and errno set.
+   If successful: The resulting string is stored in *RESULTP and its length
+   in *LENGTHP.  *RESULTP is set to a freshly allocated memory block, or is
+   unchanged if no dynamic memory allocation was necessary.  */
+extern int
+       mem_cd_iconveh (const char *src, size_t srclen,
+		       iconv_t cd, iconv_t cd1, iconv_t cd2,
+		       enum iconv_ilseq_handler handler,
+		       size_t *offsets,
+		       char **resultp, size_t *lengthp);
+
+/* Convert an entire string from one encoding to another, using iconv.
+   The original string is the NUL-terminated string starting at SRC.
+   CD is the conversion descriptor from FROMCODE to TOCODE, or (iconv_t)(-1) if
+   the system does not support a direct conversion from FROMCODE to TOCODE.
+   Both the "from" and the "to" encoding must use a single NUL byte at the end
+   of the string (i.e. not UCS-2, UCS-4, UTF-16, UTF-32).
+   CD1 is the conversion descriptor from FROM_CODESET to UTF-8 (or
+   (iconv_t)(-1) if FROM_CODESET is UTF-8).
+   CD2 is the conversion descriptor from UTF-8 to TO_CODESET (or (iconv_t)(-1)
+   if TO_CODESET is UTF-8).
+   Allocate a malloced memory block for the result.
+   Return value: the freshly allocated resulting NUL-terminated string if
+   successful, otherwise NULL and errno set.  */
+extern char *
+       str_cd_iconveh (const char *src,
+		       iconv_t cd, iconv_t cd1, iconv_t cd2,
+		       enum iconv_ilseq_handler handler);
+
+#endif
+
+/* Convert an entire string from one encoding to another, using iconv.
+   The original string is at [SRC,...,SRC+SRCLEN-1].
+   If OFFSETS is not NULL, it should point to an array of SRCLEN integers; this
+   array is filled with offsets into the result, i.e. the character starting
+   at SRC[i] corresponds to the character starting at (*RESULTP)[OFFSETS[i]],
+   and other offsets are set to (size_t)(-1).
+   *RESULTP and *LENGTH should initially be a scratch buffer and its size,
+   or *RESULTP can initially be NULL.
+   May erase the contents of the memory at *RESULTP.
+   Return value: 0 if successful, otherwise -1 and errno set.
+   If successful: The resulting string is stored in *RESULTP and its length
+   in *LENGTHP.  *RESULTP is set to a freshly allocated memory block, or is
+   unchanged if no dynamic memory allocation was necessary.  */
+extern int
+       mem_iconveh (const char *src, size_t srclen,
+		    const char *from_codeset, const char *to_codeset,
+		    enum iconv_ilseq_handler handler,
+		    size_t *offsets,
+		    char **resultp, size_t *lengthp);
+
+/* Convert an entire string from one encoding to another, using iconv.
+   The original string is the NUL-terminated string starting at SRC.
+   Both the "from" and the "to" encoding must use a single NUL byte at the
+   end of the string (i.e. not UCS-2, UCS-4, UTF-16, UTF-32).
+   Allocate a malloced memory block for the result.
+   Return value: the freshly allocated resulting NUL-terminated string if
+   successful, otherwise NULL and errno set.  */
+extern char *
+       str_iconveh (const char *src,
+		    const char *from_codeset, const char *to_codeset,
+		    enum iconv_ilseq_handler handler);
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* _STRICONVEH_H */
diff --git a/lib/string.in.h b/lib/string.in.h
new file mode 100644
index 000000000..ca029d7c0
--- /dev/null
+++ b/lib/string.in.h
@@ -0,0 +1,605 @@
+/* A GNU-like <string.h>.
+
+   Copyright (C) 1995-1996, 2001-2008 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 2, 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, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _GL_STRING_H
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+
+/* The include_next requires a split double-inclusion guard.  */
+#@INCLUDE_NEXT@ @NEXT_STRING_H@
+
+#ifndef _GL_STRING_H
+#define _GL_STRING_H
+
+
+#ifndef __attribute__
+/* This feature is available in gcc versions 2.5 and later.  */
+# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 5)
+#  define __attribute__(Spec) /* empty */
+# endif
+/* The attribute __pure__ was added in gcc 2.96.  */
+# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
+#  define __pure__ /* empty */
+# endif
+#endif
+
+
+/* The definition of GL_LINK_WARNING is copied here.  */
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Return the first occurrence of NEEDLE in HAYSTACK.  */
+#if @GNULIB_MEMMEM@
+# if @REPLACE_MEMMEM@
+#  define memmem rpl_memmem
+# endif
+# if ! @HAVE_DECL_MEMMEM@ || @REPLACE_MEMMEM@
+extern void *memmem (void const *__haystack, size_t __haystack_len,
+		     void const *__needle, size_t __needle_len)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef memmem
+# define memmem(a,al,b,bl) \
+    (GL_LINK_WARNING ("memmem is unportable and often quadratic - " \
+                      "use gnulib module memmem-simple for portability, " \
+                      "and module memmem for speed" ), \
+     memmem (a, al, b, bl))
+#endif
+
+/* Copy N bytes of SRC to DEST, return pointer to bytes after the
+   last written byte.  */
+#if @GNULIB_MEMPCPY@
+# if ! @HAVE_MEMPCPY@
+extern void *mempcpy (void *restrict __dest, void const *restrict __src,
+		      size_t __n);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef mempcpy
+# define mempcpy(a,b,n) \
+    (GL_LINK_WARNING ("mempcpy is unportable - " \
+                      "use gnulib module mempcpy for portability"), \
+     mempcpy (a, b, n))
+#endif
+
+/* Search backwards through a block for a byte (specified as an int).  */
+#if @GNULIB_MEMRCHR@
+# if ! @HAVE_DECL_MEMRCHR@
+extern void *memrchr (void const *, int, size_t)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef memrchr
+# define memrchr(a,b,c) \
+    (GL_LINK_WARNING ("memrchr is unportable - " \
+                      "use gnulib module memrchr for portability"), \
+     memrchr (a, b, c))
+#endif
+
+/* Find the first occurrence of C in S.  More efficient than
+   memchr(S,C,N), at the expense of undefined behavior if C does not
+   occur within N bytes.  */
+#if @GNULIB_RAWMEMCHR@
+# if ! @HAVE_RAWMEMCHR@
+extern void *rawmemchr (void const *__s, int __c_in)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef rawmemchr
+# define rawmemchr(a,b) \
+    (GL_LINK_WARNING ("rawmemchr is unportable - " \
+                      "use gnulib module rawmemchr for portability"), \
+     rawmemchr (a, b))
+#endif
+
+/* Copy SRC to DST, returning the address of the terminating '\0' in DST.  */
+#if @GNULIB_STPCPY@
+# if ! @HAVE_STPCPY@
+extern char *stpcpy (char *restrict __dst, char const *restrict __src);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef stpcpy
+# define stpcpy(a,b) \
+    (GL_LINK_WARNING ("stpcpy is unportable - " \
+                      "use gnulib module stpcpy for portability"), \
+     stpcpy (a, b))
+#endif
+
+/* Copy no more than N bytes of SRC to DST, returning a pointer past the
+   last non-NUL byte written into DST.  */
+#if @GNULIB_STPNCPY@
+# if ! @HAVE_STPNCPY@
+#  define stpncpy gnu_stpncpy
+extern char *stpncpy (char *restrict __dst, char const *restrict __src,
+		      size_t __n);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef stpncpy
+# define stpncpy(a,b,n) \
+    (GL_LINK_WARNING ("stpncpy is unportable - " \
+                      "use gnulib module stpncpy for portability"), \
+     stpncpy (a, b, n))
+#endif
+
+#if defined GNULIB_POSIXCHECK
+/* strchr() does not work with multibyte strings if the locale encoding is
+   GB18030 and the character to be searched is a digit.  */
+# undef strchr
+# define strchr(s,c) \
+    (GL_LINK_WARNING ("strchr cannot work correctly on character strings " \
+                      "in some multibyte locales - " \
+                      "use mbschr if you care about internationalization"), \
+     strchr (s, c))
+#endif
+
+/* Find the first occurrence of C in S or the final NUL byte.  */
+#if @GNULIB_STRCHRNUL@
+# if ! @HAVE_STRCHRNUL@
+extern char *strchrnul (char const *__s, int __c_in)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strchrnul
+# define strchrnul(a,b) \
+    (GL_LINK_WARNING ("strchrnul is unportable - " \
+                      "use gnulib module strchrnul for portability"), \
+     strchrnul (a, b))
+#endif
+
+/* Duplicate S, returning an identical malloc'd string.  */
+#if @GNULIB_STRDUP@
+# if @REPLACE_STRDUP@
+#  undef strdup
+#  define strdup rpl_strdup
+# endif
+# if !(@HAVE_DECL_STRDUP@ || defined strdup) || @REPLACE_STRDUP@
+extern char *strdup (char const *__s);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strdup
+# define strdup(a) \
+    (GL_LINK_WARNING ("strdup is unportable - " \
+                      "use gnulib module strdup for portability"), \
+     strdup (a))
+#endif
+
+/* Return a newly allocated copy of at most N bytes of STRING.  */
+#if @GNULIB_STRNDUP@
+# if ! @HAVE_STRNDUP@
+#  undef strndup
+#  define strndup rpl_strndup
+# endif
+# if ! @HAVE_STRNDUP@ || ! @HAVE_DECL_STRNDUP@
+extern char *strndup (char const *__string, size_t __n);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strndup
+# define strndup(a,n) \
+    (GL_LINK_WARNING ("strndup is unportable - " \
+                      "use gnulib module strndup for portability"), \
+     strndup (a, n))
+#endif
+
+/* Find the length (number of bytes) of STRING, but scan at most
+   MAXLEN bytes.  If no '\0' terminator is found in that many bytes,
+   return MAXLEN.  */
+#if @GNULIB_STRNLEN@
+# if ! @HAVE_DECL_STRNLEN@
+extern size_t strnlen (char const *__string, size_t __maxlen)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strnlen
+# define strnlen(a,n) \
+    (GL_LINK_WARNING ("strnlen is unportable - " \
+                      "use gnulib module strnlen for portability"), \
+     strnlen (a, n))
+#endif
+
+#if defined GNULIB_POSIXCHECK
+/* strcspn() assumes the second argument is a list of single-byte characters.
+   Even in this simple case, it does not work with multibyte strings if the
+   locale encoding is GB18030 and one of the characters to be searched is a
+   digit.  */
+# undef strcspn
+# define strcspn(s,a) \
+    (GL_LINK_WARNING ("strcspn cannot work correctly on character strings " \
+                      "in multibyte locales - " \
+                      "use mbscspn if you care about internationalization"), \
+     strcspn (s, a))
+#endif
+
+/* Find the first occurrence in S of any character in ACCEPT.  */
+#if @GNULIB_STRPBRK@
+# if ! @HAVE_STRPBRK@
+extern char *strpbrk (char const *__s, char const *__accept)
+  __attribute__ ((__pure__));
+# endif
+# if defined GNULIB_POSIXCHECK
+/* strpbrk() assumes the second argument is a list of single-byte characters.
+   Even in this simple case, it does not work with multibyte strings if the
+   locale encoding is GB18030 and one of the characters to be searched is a
+   digit.  */
+#  undef strpbrk
+#  define strpbrk(s,a) \
+     (GL_LINK_WARNING ("strpbrk cannot work correctly on character strings " \
+                       "in multibyte locales - " \
+                       "use mbspbrk if you care about internationalization"), \
+      strpbrk (s, a))
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strpbrk
+# define strpbrk(s,a) \
+    (GL_LINK_WARNING ("strpbrk is unportable - " \
+                      "use gnulib module strpbrk for portability"), \
+     strpbrk (s, a))
+#endif
+
+#if defined GNULIB_POSIXCHECK
+/* strspn() assumes the second argument is a list of single-byte characters.
+   Even in this simple case, it cannot work with multibyte strings.  */
+# undef strspn
+# define strspn(s,a) \
+    (GL_LINK_WARNING ("strspn cannot work correctly on character strings " \
+                      "in multibyte locales - " \
+                      "use mbsspn if you care about internationalization"), \
+     strspn (s, a))
+#endif
+
+#if defined GNULIB_POSIXCHECK
+/* strrchr() does not work with multibyte strings if the locale encoding is
+   GB18030 and the character to be searched is a digit.  */
+# undef strrchr
+# define strrchr(s,c) \
+    (GL_LINK_WARNING ("strrchr cannot work correctly on character strings " \
+                      "in some multibyte locales - " \
+                      "use mbsrchr if you care about internationalization"), \
+     strrchr (s, c))
+#endif
+
+/* Search the next delimiter (char listed in DELIM) starting at *STRINGP.
+   If one is found, overwrite it with a NUL, and advance *STRINGP
+   to point to the next char after it.  Otherwise, set *STRINGP to NULL.
+   If *STRINGP was already NULL, nothing happens.
+   Return the old value of *STRINGP.
+
+   This is a variant of strtok() that is multithread-safe and supports
+   empty fields.
+
+   Caveat: It modifies the original string.
+   Caveat: These functions cannot be used on constant strings.
+   Caveat: The identity of the delimiting character is lost.
+   Caveat: It doesn't work with multibyte strings unless all of the delimiter
+           characters are ASCII characters < 0x30.
+
+   See also strtok_r().  */
+#if @GNULIB_STRSEP@
+# if ! @HAVE_STRSEP@
+extern char *strsep (char **restrict __stringp, char const *restrict __delim);
+# endif
+# if defined GNULIB_POSIXCHECK
+#  undef strsep
+#  define strsep(s,d) \
+     (GL_LINK_WARNING ("strsep cannot work correctly on character strings " \
+                       "in multibyte locales - " \
+                       "use mbssep if you care about internationalization"), \
+      strsep (s, d))
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strsep
+# define strsep(s,d) \
+    (GL_LINK_WARNING ("strsep is unportable - " \
+                      "use gnulib module strsep for portability"), \
+     strsep (s, d))
+#endif
+
+#if @GNULIB_STRSTR@
+# if @REPLACE_STRSTR@
+#  define strstr rpl_strstr
+char *strstr (const char *haystack, const char *needle)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+/* strstr() does not work with multibyte strings if the locale encoding is
+   different from UTF-8:
+   POSIX says that it operates on "strings", and "string" in POSIX is defined
+   as a sequence of bytes, not of characters.  */
+# undef strstr
+# define strstr(a,b) \
+    (GL_LINK_WARNING ("strstr is quadratic on many systems, and cannot " \
+                      "work correctly on character strings in most "    \
+                      "multibyte locales - " \
+                      "use mbsstr if you care about internationalization, " \
+                      "or use strstr if you care about speed"), \
+     strstr (a, b))
+#endif
+
+/* Find the first occurrence of NEEDLE in HAYSTACK, using case-insensitive
+   comparison.  */
+#if @GNULIB_STRCASESTR@
+# if @REPLACE_STRCASESTR@
+#  define strcasestr rpl_strcasestr
+# endif
+# if ! @HAVE_STRCASESTR@ || @REPLACE_STRCASESTR@
+extern char *strcasestr (const char *haystack, const char *needle)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+/* strcasestr() does not work with multibyte strings:
+   It is a glibc extension, and glibc implements it only for unibyte
+   locales.  */
+# undef strcasestr
+# define strcasestr(a,b) \
+    (GL_LINK_WARNING ("strcasestr does work correctly on character strings " \
+                      "in multibyte locales - " \
+                      "use mbscasestr if you care about " \
+                      "internationalization, or use c-strcasestr if you want " \
+                      "a locale independent function"), \
+     strcasestr (a, b))
+#endif
+
+/* Parse S into tokens separated by characters in DELIM.
+   If S is NULL, the saved pointer in SAVE_PTR is used as
+   the next starting point.  For example:
+	char s[] = "-abc-=-def";
+	char *sp;
+	x = strtok_r(s, "-", &sp);	// x = "abc", sp = "=-def"
+	x = strtok_r(NULL, "-=", &sp);	// x = "def", sp = NULL
+	x = strtok_r(NULL, "=", &sp);	// x = NULL
+		// s = "abc\0-def\0"
+
+   This is a variant of strtok() that is multithread-safe.
+
+   For the POSIX documentation for this function, see:
+   http://www.opengroup.org/susv3xsh/strtok.html
+
+   Caveat: It modifies the original string.
+   Caveat: These functions cannot be used on constant strings.
+   Caveat: The identity of the delimiting character is lost.
+   Caveat: It doesn't work with multibyte strings unless all of the delimiter
+           characters are ASCII characters < 0x30.
+
+   See also strsep().  */
+#if @GNULIB_STRTOK_R@
+# if ! @HAVE_DECL_STRTOK_R@
+extern char *strtok_r (char *restrict s, char const *restrict delim,
+		       char **restrict save_ptr);
+# endif
+# if defined GNULIB_POSIXCHECK
+#  undef strtok_r
+#  define strtok_r(s,d,p) \
+     (GL_LINK_WARNING ("strtok_r cannot work correctly on character strings " \
+                       "in multibyte locales - " \
+                       "use mbstok_r if you care about internationalization"), \
+      strtok_r (s, d, p))
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strtok_r
+# define strtok_r(s,d,p) \
+    (GL_LINK_WARNING ("strtok_r is unportable - " \
+                      "use gnulib module strtok_r for portability"), \
+     strtok_r (s, d, p))
+#endif
+
+
+/* The following functions are not specified by POSIX.  They are gnulib
+   extensions.  */
+
+#if @GNULIB_MBSLEN@
+/* Return the number of multibyte characters in the character string STRING.
+   This considers multibyte characters, unlike strlen, which counts bytes.  */
+extern size_t mbslen (const char *string);
+#endif
+
+#if @GNULIB_MBSNLEN@
+/* Return the number of multibyte characters in the character string starting
+   at STRING and ending at STRING + LEN.  */
+extern size_t mbsnlen (const char *string, size_t len);
+#endif
+
+#if @GNULIB_MBSCHR@
+/* Locate the first single-byte character C in the character string STRING,
+   and return a pointer to it.  Return NULL if C is not found in STRING.
+   Unlike strchr(), this function works correctly in multibyte locales with
+   encodings such as GB18030.  */
+# define mbschr rpl_mbschr /* avoid collision with HP-UX function */
+extern char * mbschr (const char *string, int c);
+#endif
+
+#if @GNULIB_MBSRCHR@
+/* Locate the last single-byte character C in the character string STRING,
+   and return a pointer to it.  Return NULL if C is not found in STRING.
+   Unlike strrchr(), this function works correctly in multibyte locales with
+   encodings such as GB18030.  */
+# define mbsrchr rpl_mbsrchr /* avoid collision with HP-UX function */
+extern char * mbsrchr (const char *string, int c);
+#endif
+
+#if @GNULIB_MBSSTR@
+/* Find the first occurrence of the character string NEEDLE in the character
+   string HAYSTACK.  Return NULL if NEEDLE is not found in HAYSTACK.
+   Unlike strstr(), this function works correctly in multibyte locales with
+   encodings different from UTF-8.  */
+extern char * mbsstr (const char *haystack, const char *needle);
+#endif
+
+#if @GNULIB_MBSCASECMP@
+/* Compare the character strings S1 and S2, ignoring case, returning less than,
+   equal to or greater than zero if S1 is lexicographically less than, equal to
+   or greater than S2.
+   Note: This function may, in multibyte locales, return 0 for strings of
+   different lengths!
+   Unlike strcasecmp(), this function works correctly in multibyte locales.  */
+extern int mbscasecmp (const char *s1, const char *s2);
+#endif
+
+#if @GNULIB_MBSNCASECMP@
+/* Compare the initial segment of the character string S1 consisting of at most
+   N characters with the initial segment of the character string S2 consisting
+   of at most N characters, ignoring case, returning less than, equal to or
+   greater than zero if the initial segment of S1 is lexicographically less
+   than, equal to or greater than the initial segment of S2.
+   Note: This function may, in multibyte locales, return 0 for initial segments
+   of different lengths!
+   Unlike strncasecmp(), this function works correctly in multibyte locales.
+   But beware that N is not a byte count but a character count!  */
+extern int mbsncasecmp (const char *s1, const char *s2, size_t n);
+#endif
+
+#if @GNULIB_MBSPCASECMP@
+/* Compare the initial segment of the character string STRING consisting of
+   at most mbslen (PREFIX) characters with the character string PREFIX,
+   ignoring case, returning less than, equal to or greater than zero if this
+   initial segment is lexicographically less than, equal to or greater than
+   PREFIX.
+   Note: This function may, in multibyte locales, return 0 if STRING is of
+   smaller length than PREFIX!
+   Unlike strncasecmp(), this function works correctly in multibyte
+   locales.  */
+extern char * mbspcasecmp (const char *string, const char *prefix);
+#endif
+
+#if @GNULIB_MBSCASESTR@
+/* Find the first occurrence of the character string NEEDLE in the character
+   string HAYSTACK, using case-insensitive comparison.
+   Note: This function may, in multibyte locales, return success even if
+   strlen (haystack) < strlen (needle) !
+   Unlike strcasestr(), this function works correctly in multibyte locales.  */
+extern char * mbscasestr (const char *haystack, const char *needle);
+#endif
+
+#if @GNULIB_MBSCSPN@
+/* Find the first occurrence in the character string STRING of any character
+   in the character string ACCEPT.  Return the number of bytes from the
+   beginning of the string to this occurrence, or to the end of the string
+   if none exists.
+   Unlike strcspn(), this function works correctly in multibyte locales.  */
+extern size_t mbscspn (const char *string, const char *accept);
+#endif
+
+#if @GNULIB_MBSPBRK@
+/* Find the first occurrence in the character string STRING of any character
+   in the character string ACCEPT.  Return the pointer to it, or NULL if none
+   exists.
+   Unlike strpbrk(), this function works correctly in multibyte locales.  */
+# define mbspbrk rpl_mbspbrk /* avoid collision with HP-UX function */
+extern char * mbspbrk (const char *string, const char *accept);
+#endif
+
+#if @GNULIB_MBSSPN@
+/* Find the first occurrence in the character string STRING of any character
+   not in the character string REJECT.  Return the number of bytes from the
+   beginning of the string to this occurrence, or to the end of the string
+   if none exists.
+   Unlike strspn(), this function works correctly in multibyte locales.  */
+extern size_t mbsspn (const char *string, const char *reject);
+#endif
+
+#if @GNULIB_MBSSEP@
+/* Search the next delimiter (multibyte character listed in the character
+   string DELIM) starting at the character string *STRINGP.
+   If one is found, overwrite it with a NUL, and advance *STRINGP to point
+   to the next multibyte character after it.  Otherwise, set *STRINGP to NULL.
+   If *STRINGP was already NULL, nothing happens.
+   Return the old value of *STRINGP.
+
+   This is a variant of mbstok_r() that supports empty fields.
+
+   Caveat: It modifies the original string.
+   Caveat: These functions cannot be used on constant strings.
+   Caveat: The identity of the delimiting character is lost.
+
+   See also mbstok_r().  */
+extern char * mbssep (char **stringp, const char *delim);
+#endif
+
+#if @GNULIB_MBSTOK_R@
+/* Parse the character string STRING into tokens separated by characters in
+   the character string DELIM.
+   If STRING is NULL, the saved pointer in SAVE_PTR is used as
+   the next starting point.  For example:
+	char s[] = "-abc-=-def";
+	char *sp;
+	x = mbstok_r(s, "-", &sp);	// x = "abc", sp = "=-def"
+	x = mbstok_r(NULL, "-=", &sp);	// x = "def", sp = NULL
+	x = mbstok_r(NULL, "=", &sp);	// x = NULL
+		// s = "abc\0-def\0"
+
+   Caveat: It modifies the original string.
+   Caveat: These functions cannot be used on constant strings.
+   Caveat: The identity of the delimiting character is lost.
+
+   See also mbssep().  */
+extern char * mbstok_r (char *string, const char *delim, char **save_ptr);
+#endif
+
+/* Map any int, typically from errno, into an error message.  */
+#if @GNULIB_STRERROR@
+# if @REPLACE_STRERROR@
+#  undef strerror
+#  define strerror rpl_strerror
+extern char *strerror (int);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strerror
+# define strerror(e) \
+    (GL_LINK_WARNING ("strerror is unportable - " \
+                      "use gnulib module strerror to guarantee non-NULL result"), \
+     strerror (e))
+#endif
+
+#if @GNULIB_STRSIGNAL@
+# if @REPLACE_STRSIGNAL@
+#  define strsignal rpl_strsignal
+# endif
+# if ! @HAVE_DECL_STRSIGNAL@ || @REPLACE_STRSIGNAL@
+extern char *strsignal (int __sig);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strsignal
+# define strsignal(a) \
+    (GL_LINK_WARNING ("strsignal is unportable - " \
+                      "use gnulib module strsignal for portability"), \
+     strsignal (a))
+#endif
+
+#if @GNULIB_STRVERSCMP@
+# if !@HAVE_STRVERSCMP@
+extern int strverscmp (const char *, const char *);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strverscmp
+# define strverscmp(a, b) \
+    (GL_LINK_WARNING ("strverscmp is unportable - " \
+                      "use gnulib module strverscmp for portability"), \
+     strverscmp (a, b))
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _GL_STRING_H */
+#endif /* _GL_STRING_H */
diff --git a/lib/unistr.h b/lib/unistr.h
new file mode 100644
index 000000000..83ff13411
--- /dev/null
+++ b/lib/unistr.h
@@ -0,0 +1,681 @@
+/* Elementary Unicode string functions.
+   Copyright (C) 2001-2002, 2005-2009 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _UNISTR_H
+#define _UNISTR_H
+
+#include "unitypes.h"
+
+/* Get bool.  */
+#include <stdbool.h>
+
+/* Get size_t.  */
+#include <stddef.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Conventions:
+
+   All functions prefixed with u8_ operate on UTF-8 encoded strings.
+   Their unit is an uint8_t (1 byte).
+
+   All functions prefixed with u16_ operate on UTF-16 encoded strings.
+   Their unit is an uint16_t (a 2-byte word).
+
+   All functions prefixed with u32_ operate on UCS-4 encoded strings.
+   Their unit is an uint32_t (a 4-byte word).
+
+   All argument pairs (s, n) denote a Unicode string s[0..n-1] with exactly
+   n units.
+
+   All arguments starting with "str" and the arguments of functions starting
+   with u8_str/u16_str/u32_str denote a NUL terminated string, i.e. a string
+   which terminates at the first NUL unit.  This termination unit is
+   considered part of the string for all memory allocation purposes, but
+   is not considered part of the string for all other logical purposes.
+
+   Functions returning a string result take a (resultbuf, lengthp) argument
+   pair.  If resultbuf is not NULL and the result fits into *lengthp units,
+   it is put in resultbuf, and resultbuf is returned.  Otherwise, a freshly
+   allocated string is returned.  In both cases, *lengthp is set to the
+   length (number of units) of the returned string.  In case of error,
+   NULL is returned and errno is set.  */
+
+
+/* Elementary string checks.  */
+
+/* Check whether an UTF-8 string is well-formed.
+   Return NULL if valid, or a pointer to the first invalid unit otherwise.  */
+extern const uint8_t *
+       u8_check (const uint8_t *s, size_t n);
+
+/* Check whether an UTF-16 string is well-formed.
+   Return NULL if valid, or a pointer to the first invalid unit otherwise.  */
+extern const uint16_t *
+       u16_check (const uint16_t *s, size_t n);
+
+/* Check whether an UCS-4 string is well-formed.
+   Return NULL if valid, or a pointer to the first invalid unit otherwise.  */
+extern const uint32_t *
+       u32_check (const uint32_t *s, size_t n);
+
+
+/* Elementary string conversions.  */
+
+/* Convert an UTF-8 string to an UTF-16 string.  */
+extern uint16_t *
+       u8_to_u16 (const uint8_t *s, size_t n, uint16_t *resultbuf,
+		  size_t *lengthp);
+
+/* Convert an UTF-8 string to an UCS-4 string.  */
+extern uint32_t *
+       u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf,
+		  size_t *lengthp);
+
+/* Convert an UTF-16 string to an UTF-8 string.  */
+extern uint8_t *
+       u16_to_u8 (const uint16_t *s, size_t n, uint8_t *resultbuf,
+		  size_t *lengthp);
+
+/* Convert an UTF-16 string to an UCS-4 string.  */
+extern uint32_t *
+       u16_to_u32 (const uint16_t *s, size_t n, uint32_t *resultbuf,
+		   size_t *lengthp);
+
+/* Convert an UCS-4 string to an UTF-8 string.  */
+extern uint8_t *
+       u32_to_u8 (const uint32_t *s, size_t n, uint8_t *resultbuf,
+		  size_t *lengthp);
+
+/* Convert an UCS-4 string to an UTF-16 string.  */
+extern uint16_t *
+       u32_to_u16 (const uint32_t *s, size_t n, uint16_t *resultbuf,
+		   size_t *lengthp);
+
+
+/* Elementary string functions.  */
+
+/* Return the length (number of units) of the first character in S, which is
+   no longer than N.  Return 0 if it is the NUL character.  Return -1 upon
+   failure.  */
+/* Similar to mblen(), except that s must not be NULL.  */
+extern int
+       u8_mblen (const uint8_t *s, size_t n);
+extern int
+       u16_mblen (const uint16_t *s, size_t n);
+extern int
+       u32_mblen (const uint32_t *s, size_t n);
+
+/* Return the length (number of units) of the first character in S, putting
+   its 'ucs4_t' representation in *PUC.  Upon failure, *PUC is set to 0xfffd,
+   and an appropriate number of units is returned.
+   The number of available units, N, must be > 0.  */
+/* Similar to mbtowc(), except that puc and s must not be NULL, n must be > 0,
+   and the NUL character is not treated specially.  */
+/* The variants with _safe suffix are safe, even if the library is compiled
+   without --enable-safety.  */
+
+#ifdef GNULIB_UNISTR_U8_MBTOUC_UNSAFE
+# if !HAVE_INLINE
+extern int
+       u8_mbtouc_unsafe (ucs4_t *puc, const uint8_t *s, size_t n);
+# else
+extern int
+       u8_mbtouc_unsafe_aux (ucs4_t *puc, const uint8_t *s, size_t n);
+static inline int
+u8_mbtouc_unsafe (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else
+    return u8_mbtouc_unsafe_aux (puc, s, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U16_MBTOUC_UNSAFE
+# if !HAVE_INLINE
+extern int
+       u16_mbtouc_unsafe (ucs4_t *puc, const uint16_t *s, size_t n);
+# else
+extern int
+       u16_mbtouc_unsafe_aux (ucs4_t *puc, const uint16_t *s, size_t n);
+static inline int
+u16_mbtouc_unsafe (ucs4_t *puc, const uint16_t *s, size_t n)
+{
+  uint16_t c = *s;
+
+  if (c < 0xd800 || c >= 0xe000)
+    {
+      *puc = c;
+      return 1;
+    }
+  else
+    return u16_mbtouc_unsafe_aux (puc, s, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U32_MBTOUC_UNSAFE
+# if !HAVE_INLINE
+extern int
+       u32_mbtouc_unsafe (ucs4_t *puc, const uint32_t *s, size_t n);
+# else
+static inline int
+u32_mbtouc_unsafe (ucs4_t *puc, const uint32_t *s, size_t n _UNUSED_PARAMETER_)
+{
+  uint32_t c = *s;
+
+#  if CONFIG_UNICODE_SAFETY
+  if (c < 0xd800 || (c >= 0xe000 && c < 0x110000))
+#  endif
+    *puc = c;
+#  if CONFIG_UNICODE_SAFETY
+  else
+    /* invalid multibyte character */
+    *puc = 0xfffd;
+#  endif
+  return 1;
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U8_MBTOUC
+# if !HAVE_INLINE
+extern int
+       u8_mbtouc (ucs4_t *puc, const uint8_t *s, size_t n);
+# else
+extern int
+       u8_mbtouc_aux (ucs4_t *puc, const uint8_t *s, size_t n);
+static inline int
+u8_mbtouc (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else
+    return u8_mbtouc_aux (puc, s, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U16_MBTOUC
+# if !HAVE_INLINE
+extern int
+       u16_mbtouc (ucs4_t *puc, const uint16_t *s, size_t n);
+# else
+extern int
+       u16_mbtouc_aux (ucs4_t *puc, const uint16_t *s, size_t n);
+static inline int
+u16_mbtouc (ucs4_t *puc, const uint16_t *s, size_t n)
+{
+  uint16_t c = *s;
+
+  if (c < 0xd800 || c >= 0xe000)
+    {
+      *puc = c;
+      return 1;
+    }
+  else
+    return u16_mbtouc_aux (puc, s, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U32_MBTOUC
+# if !HAVE_INLINE
+extern int
+       u32_mbtouc (ucs4_t *puc, const uint32_t *s, size_t n);
+# else
+static inline int
+u32_mbtouc (ucs4_t *puc, const uint32_t *s, size_t n _UNUSED_PARAMETER_)
+{
+  uint32_t c = *s;
+
+  if (c < 0xd800 || (c >= 0xe000 && c < 0x110000))
+    *puc = c;
+  else
+    /* invalid multibyte character */
+    *puc = 0xfffd;
+  return 1;
+}
+# endif
+#endif
+
+/* Return the length (number of units) of the first character in S, putting
+   its 'ucs4_t' representation in *PUC.  Upon failure, *PUC is set to 0xfffd,
+   and -1 is returned for an invalid sequence of units, -2 is returned for an
+   incomplete sequence of units.
+   The number of available units, N, must be > 0.  */
+/* Similar to u*_mbtouc(), except that the return value gives more details
+   about the failure, similar to mbrtowc().  */
+
+#ifdef GNULIB_UNISTR_U8_MBTOUCR
+extern int
+       u8_mbtoucr (ucs4_t *puc, const uint8_t *s, size_t n);
+#endif
+
+#ifdef GNULIB_UNISTR_U16_MBTOUCR
+extern int
+       u16_mbtoucr (ucs4_t *puc, const uint16_t *s, size_t n);
+#endif
+
+#ifdef GNULIB_UNISTR_U32_MBTOUCR
+extern int
+       u32_mbtoucr (ucs4_t *puc, const uint32_t *s, size_t n);
+#endif
+
+/* Put the multibyte character represented by UC in S, returning its
+   length.  Return -1 upon failure, -2 if the number of available units, N,
+   is too small.  The latter case cannot occur if N >= 6/2/1, respectively.  */
+/* Similar to wctomb(), except that s must not be NULL, and the argument n
+   must be specified.  */
+
+#ifdef GNULIB_UNISTR_U8_UCTOMB
+/* Auxiliary function, also used by u8_chr, u8_strchr, u8_strrchr.  */
+extern int
+       u8_uctomb_aux (uint8_t *s, ucs4_t uc, int n);
+# if !HAVE_INLINE
+extern int
+       u8_uctomb (uint8_t *s, ucs4_t uc, int n);
+# else
+static inline int
+u8_uctomb (uint8_t *s, ucs4_t uc, int n)
+{
+  if (uc < 0x80 && n > 0)
+    {
+      s[0] = uc;
+      return 1;
+    }
+  else
+    return u8_uctomb_aux (s, uc, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U16_UCTOMB
+/* Auxiliary function, also used by u16_chr, u16_strchr, u16_strrchr.  */
+extern int
+       u16_uctomb_aux (uint16_t *s, ucs4_t uc, int n);
+# if !HAVE_INLINE
+extern int
+       u16_uctomb (uint16_t *s, ucs4_t uc, int n);
+# else
+static inline int
+u16_uctomb (uint16_t *s, ucs4_t uc, int n)
+{
+  if (uc < 0xd800 && n > 0)
+    {
+      s[0] = uc;
+      return 1;
+    }
+  else
+    return u16_uctomb_aux (s, uc, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U32_UCTOMB
+# if !HAVE_INLINE
+extern int
+       u32_uctomb (uint32_t *s, ucs4_t uc, int n);
+# else
+static inline int
+u32_uctomb (uint32_t *s, ucs4_t uc, int n)
+{
+  if (uc < 0xd800 || (uc >= 0xe000 && uc < 0x110000))
+    {
+      if (n > 0)
+	{
+	  *s = uc;
+	  return 1;
+	}
+      else
+	return -2;
+    }
+  else
+    return -1;
+}
+# endif
+#endif
+
+/* Copy N units from SRC to DEST.  */
+/* Similar to memcpy().  */
+extern uint8_t *
+       u8_cpy (uint8_t *dest, const uint8_t *src, size_t n);
+extern uint16_t *
+       u16_cpy (uint16_t *dest, const uint16_t *src, size_t n);
+extern uint32_t *
+       u32_cpy (uint32_t *dest, const uint32_t *src, size_t n);
+
+/* Copy N units from SRC to DEST, guaranteeing correct behavior for
+   overlapping memory areas.  */
+/* Similar to memmove().  */
+extern uint8_t *
+       u8_move (uint8_t *dest, const uint8_t *src, size_t n);
+extern uint16_t *
+       u16_move (uint16_t *dest, const uint16_t *src, size_t n);
+extern uint32_t *
+       u32_move (uint32_t *dest, const uint32_t *src, size_t n);
+
+/* Set the first N characters of S to UC.  UC should be a character that
+   occupies only 1 unit.  */
+/* Similar to memset().  */
+extern uint8_t *
+       u8_set (uint8_t *s, ucs4_t uc, size_t n);
+extern uint16_t *
+       u16_set (uint16_t *s, ucs4_t uc, size_t n);
+extern uint32_t *
+       u32_set (uint32_t *s, ucs4_t uc, size_t n);
+
+/* Compare S1 and S2, each of length N.  */
+/* Similar to memcmp().  */
+extern int
+       u8_cmp (const uint8_t *s1, const uint8_t *s2, size_t n);
+extern int
+       u16_cmp (const uint16_t *s1, const uint16_t *s2, size_t n);
+extern int
+       u32_cmp (const uint32_t *s1, const uint32_t *s2, size_t n);
+
+/* Compare S1 and S2.  */
+/* Similar to the gnulib function memcmp2().  */
+extern int
+       u8_cmp2 (const uint8_t *s1, size_t n1, const uint8_t *s2, size_t n2);
+extern int
+       u16_cmp2 (const uint16_t *s1, size_t n1, const uint16_t *s2, size_t n2);
+extern int
+       u32_cmp2 (const uint32_t *s1, size_t n1, const uint32_t *s2, size_t n2);
+
+/* Search the string at S for UC.  */
+/* Similar to memchr().  */
+extern uint8_t *
+       u8_chr (const uint8_t *s, size_t n, ucs4_t uc);
+extern uint16_t *
+       u16_chr (const uint16_t *s, size_t n, ucs4_t uc);
+extern uint32_t *
+       u32_chr (const uint32_t *s, size_t n, ucs4_t uc);
+
+/* Count the number of Unicode characters in the N units from S.  */
+/* Similar to mbsnlen().  */
+extern size_t
+       u8_mbsnlen (const uint8_t *s, size_t n);
+extern size_t
+       u16_mbsnlen (const uint16_t *s, size_t n);
+extern size_t
+       u32_mbsnlen (const uint32_t *s, size_t n);
+
+/* Elementary string functions with memory allocation.  */
+
+/* Make a freshly allocated copy of S, of length N.  */
+extern uint8_t *
+       u8_cpy_alloc (const uint8_t *s, size_t n);
+extern uint16_t *
+       u16_cpy_alloc (const uint16_t *s, size_t n);
+extern uint32_t *
+       u32_cpy_alloc (const uint32_t *s, size_t n);
+
+/* Elementary string functions on NUL terminated strings.  */
+
+/* Return the length (number of units) of the first character in S.
+   Return 0 if it is the NUL character.  Return -1 upon failure.  */
+extern int
+       u8_strmblen (const uint8_t *s);
+extern int
+       u16_strmblen (const uint16_t *s);
+extern int
+       u32_strmblen (const uint32_t *s);
+
+/* Return the length (number of units) of the first character in S, putting
+   its 'ucs4_t' representation in *PUC.  Return 0 if it is the NUL
+   character.  Return -1 upon failure.  */
+extern int
+       u8_strmbtouc (ucs4_t *puc, const uint8_t *s);
+extern int
+       u16_strmbtouc (ucs4_t *puc, const uint16_t *s);
+extern int
+       u32_strmbtouc (ucs4_t *puc, const uint32_t *s);
+
+/* Forward iteration step.  Advances the pointer past the next character,
+   or returns NULL if the end of the string has been reached.  Puts the
+   character's 'ucs4_t' representation in *PUC.  */
+extern const uint8_t *
+       u8_next (ucs4_t *puc, const uint8_t *s);
+extern const uint16_t *
+       u16_next (ucs4_t *puc, const uint16_t *s);
+extern const uint32_t *
+       u32_next (ucs4_t *puc, const uint32_t *s);
+
+/* Backward iteration step.  Advances the pointer to point to the previous
+   character, or returns NULL if the beginning of the string had been reached.
+   Puts the character's 'ucs4_t' representation in *PUC.  */
+extern const uint8_t *
+       u8_prev (ucs4_t *puc, const uint8_t *s, const uint8_t *start);
+extern const uint16_t *
+       u16_prev (ucs4_t *puc, const uint16_t *s, const uint16_t *start);
+extern const uint32_t *
+       u32_prev (ucs4_t *puc, const uint32_t *s, const uint32_t *start);
+
+/* Return the number of units in S.  */
+/* Similar to strlen(), wcslen().  */
+extern size_t
+       u8_strlen (const uint8_t *s);
+extern size_t
+       u16_strlen (const uint16_t *s);
+extern size_t
+       u32_strlen (const uint32_t *s);
+
+/* Return the number of units in S, but at most MAXLEN.  */
+/* Similar to strnlen(), wcsnlen().  */
+extern size_t
+       u8_strnlen (const uint8_t *s, size_t maxlen);
+extern size_t
+       u16_strnlen (const uint16_t *s, size_t maxlen);
+extern size_t
+       u32_strnlen (const uint32_t *s, size_t maxlen);
+
+/* Copy SRC to DEST.  */
+/* Similar to strcpy(), wcscpy().  */
+extern uint8_t *
+       u8_strcpy (uint8_t *dest, const uint8_t *src);
+extern uint16_t *
+       u16_strcpy (uint16_t *dest, const uint16_t *src);
+extern uint32_t *
+       u32_strcpy (uint32_t *dest, const uint32_t *src);
+
+/* Copy SRC to DEST, returning the address of the terminating NUL in DEST.  */
+/* Similar to stpcpy().  */
+extern uint8_t *
+       u8_stpcpy (uint8_t *dest, const uint8_t *src);
+extern uint16_t *
+       u16_stpcpy (uint16_t *dest, const uint16_t *src);
+extern uint32_t *
+       u32_stpcpy (uint32_t *dest, const uint32_t *src);
+
+/* Copy no more than N units of SRC to DEST.  */
+/* Similar to strncpy(), wcsncpy().  */
+extern uint8_t *
+       u8_strncpy (uint8_t *dest, const uint8_t *src, size_t n);
+extern uint16_t *
+       u16_strncpy (uint16_t *dest, const uint16_t *src, size_t n);
+extern uint32_t *
+       u32_strncpy (uint32_t *dest, const uint32_t *src, size_t n);
+
+/* Copy no more than N units of SRC to DEST, returning the address of
+   the last unit written into DEST.  */
+/* Similar to stpncpy().  */
+extern uint8_t *
+       u8_stpncpy (uint8_t *dest, const uint8_t *src, size_t n);
+extern uint16_t *
+       u16_stpncpy (uint16_t *dest, const uint16_t *src, size_t n);
+extern uint32_t *
+       u32_stpncpy (uint32_t *dest, const uint32_t *src, size_t n);
+
+/* Append SRC onto DEST.  */
+/* Similar to strcat(), wcscat().  */
+extern uint8_t *
+       u8_strcat (uint8_t *dest, const uint8_t *src);
+extern uint16_t *
+       u16_strcat (uint16_t *dest, const uint16_t *src);
+extern uint32_t *
+       u32_strcat (uint32_t *dest, const uint32_t *src);
+
+/* Append no more than N units of SRC onto DEST.  */
+/* Similar to strncat(), wcsncat().  */
+extern uint8_t *
+       u8_strncat (uint8_t *dest, const uint8_t *src, size_t n);
+extern uint16_t *
+       u16_strncat (uint16_t *dest, const uint16_t *src, size_t n);
+extern uint32_t *
+       u32_strncat (uint32_t *dest, const uint32_t *src, size_t n);
+
+/* Compare S1 and S2.  */
+/* Similar to strcmp(), wcscmp().  */
+extern int
+       u8_strcmp (const uint8_t *s1, const uint8_t *s2);
+extern int
+       u16_strcmp (const uint16_t *s1, const uint16_t *s2);
+extern int
+       u32_strcmp (const uint32_t *s1, const uint32_t *s2);
+
+/* Compare S1 and S2 using the collation rules of the current locale.
+   Return -1 if S1 < S2, 0 if S1 = S2, 1 if S1 > S2.
+   Upon failure, set errno and return any value.  */
+/* Similar to strcoll(), wcscoll().  */
+extern int
+       u8_strcoll (const uint8_t *s1, const uint8_t *s2);
+extern int
+       u16_strcoll (const uint16_t *s1, const uint16_t *s2);
+extern int
+       u32_strcoll (const uint32_t *s1, const uint32_t *s2);
+
+/* Compare no more than N units of S1 and S2.  */
+/* Similar to strncmp(), wcsncmp().  */
+extern int
+       u8_strncmp (const uint8_t *s1, const uint8_t *s2, size_t n);
+extern int
+       u16_strncmp (const uint16_t *s1, const uint16_t *s2, size_t n);
+extern int
+       u32_strncmp (const uint32_t *s1, const uint32_t *s2, size_t n);
+
+/* Duplicate S, returning an identical malloc'd string.  */
+/* Similar to strdup(), wcsdup().  */
+extern uint8_t *
+       u8_strdup (const uint8_t *s);
+extern uint16_t *
+       u16_strdup (const uint16_t *s);
+extern uint32_t *
+       u32_strdup (const uint32_t *s);
+
+/* Find the first occurrence of UC in STR.  */
+/* Similar to strchr(), wcschr().  */
+extern uint8_t *
+       u8_strchr (const uint8_t *str, ucs4_t uc);
+extern uint16_t *
+       u16_strchr (const uint16_t *str, ucs4_t uc);
+extern uint32_t *
+       u32_strchr (const uint32_t *str, ucs4_t uc);
+
+/* Find the last occurrence of UC in STR.  */
+/* Similar to strrchr(), wcsrchr().  */
+extern uint8_t *
+       u8_strrchr (const uint8_t *str, ucs4_t uc);
+extern uint16_t *
+       u16_strrchr (const uint16_t *str, ucs4_t uc);
+extern uint32_t *
+       u32_strrchr (const uint32_t *str, ucs4_t uc);
+
+/* Return the length of the initial segment of STR which consists entirely
+   of Unicode characters not in REJECT.  */
+/* Similar to strcspn(), wcscspn().  */
+extern size_t
+       u8_strcspn (const uint8_t *str, const uint8_t *reject);
+extern size_t
+       u16_strcspn (const uint16_t *str, const uint16_t *reject);
+extern size_t
+       u32_strcspn (const uint32_t *str, const uint32_t *reject);
+
+/* Return the length of the initial segment of STR which consists entirely
+   of Unicode characters in ACCEPT.  */
+/* Similar to strspn(), wcsspn().  */
+extern size_t
+       u8_strspn (const uint8_t *str, const uint8_t *accept);
+extern size_t
+       u16_strspn (const uint16_t *str, const uint16_t *accept);
+extern size_t
+       u32_strspn (const uint32_t *str, const uint32_t *accept);
+
+/* Find the first occurrence in STR of any character in ACCEPT.  */
+/* Similar to strpbrk(), wcspbrk().  */
+extern uint8_t *
+       u8_strpbrk (const uint8_t *str, const uint8_t *accept);
+extern uint16_t *
+       u16_strpbrk (const uint16_t *str, const uint16_t *accept);
+extern uint32_t *
+       u32_strpbrk (const uint32_t *str, const uint32_t *accept);
+
+/* Find the first occurrence of NEEDLE in HAYSTACK.  */
+/* Similar to strstr(), wcsstr().  */
+extern uint8_t *
+       u8_strstr (const uint8_t *haystack, const uint8_t *needle);
+extern uint16_t *
+       u16_strstr (const uint16_t *haystack, const uint16_t *needle);
+extern uint32_t *
+       u32_strstr (const uint32_t *haystack, const uint32_t *needle);
+
+/* Test whether STR starts with PREFIX.  */
+extern bool
+       u8_startswith (const uint8_t *str, const uint8_t *prefix);
+extern bool
+       u16_startswith (const uint16_t *str, const uint16_t *prefix);
+extern bool
+       u32_startswith (const uint32_t *str, const uint32_t *prefix);
+
+/* Test whether STR ends with SUFFIX.  */
+extern bool
+       u8_endswith (const uint8_t *str, const uint8_t *suffix);
+extern bool
+       u16_endswith (const uint16_t *str, const uint16_t *suffix);
+extern bool
+       u32_endswith (const uint32_t *str, const uint32_t *suffix);
+
+/* Divide STR into tokens separated by characters in DELIM.
+   This interface is actually more similar to wcstok than to strtok.  */
+/* Similar to strtok_r(), wcstok().  */
+extern uint8_t *
+       u8_strtok (uint8_t *str, const uint8_t *delim, uint8_t **ptr);
+extern uint16_t *
+       u16_strtok (uint16_t *str, const uint16_t *delim, uint16_t **ptr);
+extern uint32_t *
+       u32_strtok (uint32_t *str, const uint32_t *delim, uint32_t **ptr);
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _UNISTR_H */
diff --git a/lib/unistr/u8-mbtouc-aux.c b/lib/unistr/u8-mbtouc-aux.c
new file mode 100644
index 000000000..53d02bf0d
--- /dev/null
+++ b/lib/unistr/u8-mbtouc-aux.c
@@ -0,0 +1,158 @@
+/* Conversion UTF-8 to UCS-4.
+   Copyright (C) 2001-2002, 2006-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2001.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "unistr.h"
+
+#if defined IN_LIBUNISTRING || HAVE_INLINE
+
+int
+u8_mbtouc_aux (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40)
+		{
+		  *puc = ((unsigned int) (c & 0x1f) << 6)
+		         | (unsigned int) (s[1] ^ 0x80);
+		  return 2;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf0)
+	{
+	  if (n >= 3)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (c >= 0xe1 || s[1] >= 0xa0)
+		  && (c != 0xed || s[1] < 0xa0))
+		{
+		  *puc = ((unsigned int) (c & 0x0f) << 12)
+		         | ((unsigned int) (s[1] ^ 0x80) << 6)
+		         | (unsigned int) (s[2] ^ 0x80);
+		  return 3;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf8)
+	{
+	  if (n >= 4)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40
+		  && (c >= 0xf1 || s[1] >= 0x90)
+#if 1
+		  && (c < 0xf4 || (c == 0xf4 && s[1] < 0x90))
+#endif
+		 )
+		{
+		  *puc = ((unsigned int) (c & 0x07) << 18)
+		         | ((unsigned int) (s[1] ^ 0x80) << 12)
+		         | ((unsigned int) (s[2] ^ 0x80) << 6)
+		         | (unsigned int) (s[3] ^ 0x80);
+		  return 4;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#if 0
+      else if (c < 0xfc)
+	{
+	  if (n >= 5)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (c >= 0xf9 || s[1] >= 0x88))
+		{
+		  *puc = ((unsigned int) (c & 0x03) << 24)
+		         | ((unsigned int) (s[1] ^ 0x80) << 18)
+		         | ((unsigned int) (s[2] ^ 0x80) << 12)
+		         | ((unsigned int) (s[3] ^ 0x80) << 6)
+		         | (unsigned int) (s[4] ^ 0x80);
+		  return 5;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xfe)
+	{
+	  if (n >= 6)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (s[5] ^ 0x80) < 0x40
+		  && (c >= 0xfd || s[1] >= 0x84))
+		{
+		  *puc = ((unsigned int) (c & 0x01) << 30)
+		         | ((unsigned int) (s[1] ^ 0x80) << 24)
+		         | ((unsigned int) (s[2] ^ 0x80) << 18)
+		         | ((unsigned int) (s[3] ^ 0x80) << 12)
+		         | ((unsigned int) (s[4] ^ 0x80) << 6)
+		         | (unsigned int) (s[5] ^ 0x80);
+		  return 6;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#endif
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return 1;
+}
+
+#endif
diff --git a/lib/unistr/u8-mbtouc-unsafe-aux.c b/lib/unistr/u8-mbtouc-unsafe-aux.c
new file mode 100644
index 000000000..43e4a360f
--- /dev/null
+++ b/lib/unistr/u8-mbtouc-unsafe-aux.c
@@ -0,0 +1,168 @@
+/* Conversion UTF-8 to UCS-4.
+   Copyright (C) 2001-2002, 2006-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2001.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "unistr.h"
+
+#if defined IN_LIBUNISTRING || HAVE_INLINE
+
+int
+u8_mbtouc_unsafe_aux (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+	{
+	  if (n >= 2)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40)
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x1f) << 6)
+		         | (unsigned int) (s[1] ^ 0x80);
+		  return 2;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf0)
+	{
+	  if (n >= 3)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (c >= 0xe1 || s[1] >= 0xa0)
+		  && (c != 0xed || s[1] < 0xa0))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x0f) << 12)
+		         | ((unsigned int) (s[1] ^ 0x80) << 6)
+		         | (unsigned int) (s[2] ^ 0x80);
+		  return 3;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf8)
+	{
+	  if (n >= 4)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40
+		  && (c >= 0xf1 || s[1] >= 0x90)
+#if 1
+		  && (c < 0xf4 || (c == 0xf4 && s[1] < 0x90))
+#endif
+		 )
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x07) << 18)
+		         | ((unsigned int) (s[1] ^ 0x80) << 12)
+		         | ((unsigned int) (s[2] ^ 0x80) << 6)
+		         | (unsigned int) (s[3] ^ 0x80);
+		  return 4;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#if 0
+      else if (c < 0xfc)
+	{
+	  if (n >= 5)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (c >= 0xf9 || s[1] >= 0x88))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x03) << 24)
+		         | ((unsigned int) (s[1] ^ 0x80) << 18)
+		         | ((unsigned int) (s[2] ^ 0x80) << 12)
+		         | ((unsigned int) (s[3] ^ 0x80) << 6)
+		         | (unsigned int) (s[4] ^ 0x80);
+		  return 5;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xfe)
+	{
+	  if (n >= 6)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (s[5] ^ 0x80) < 0x40
+		  && (c >= 0xfd || s[1] >= 0x84))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x01) << 30)
+		         | ((unsigned int) (s[1] ^ 0x80) << 24)
+		         | ((unsigned int) (s[2] ^ 0x80) << 18)
+		         | ((unsigned int) (s[3] ^ 0x80) << 12)
+		         | ((unsigned int) (s[4] ^ 0x80) << 6)
+		         | (unsigned int) (s[5] ^ 0x80);
+		  return 6;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#endif
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return 1;
+}
+
+#endif
diff --git a/lib/unistr/u8-mbtouc-unsafe.c b/lib/unistr/u8-mbtouc-unsafe.c
new file mode 100644
index 000000000..466156967
--- /dev/null
+++ b/lib/unistr/u8-mbtouc-unsafe.c
@@ -0,0 +1,179 @@
+/* Look at first character in UTF-8 string.
+   Copyright (C) 1999-2002, 2006-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2001.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#if defined IN_LIBUNISTRING
+/* Tell unistr.h to declare u8_mbtouc_unsafe as 'extern', not
+   'static inline'.  */
+# include "unistring-notinline.h"
+#endif
+
+/* Specification.  */
+#include "unistr.h"
+
+#if !HAVE_INLINE
+
+int
+u8_mbtouc_unsafe (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+	{
+	  if (n >= 2)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40)
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x1f) << 6)
+		         | (unsigned int) (s[1] ^ 0x80);
+		  return 2;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf0)
+	{
+	  if (n >= 3)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (c >= 0xe1 || s[1] >= 0xa0)
+		  && (c != 0xed || s[1] < 0xa0))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x0f) << 12)
+		         | ((unsigned int) (s[1] ^ 0x80) << 6)
+		         | (unsigned int) (s[2] ^ 0x80);
+		  return 3;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf8)
+	{
+	  if (n >= 4)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40
+		  && (c >= 0xf1 || s[1] >= 0x90)
+#if 1
+		  && (c < 0xf4 || (c == 0xf4 && s[1] < 0x90))
+#endif
+		 )
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x07) << 18)
+		         | ((unsigned int) (s[1] ^ 0x80) << 12)
+		         | ((unsigned int) (s[2] ^ 0x80) << 6)
+		         | (unsigned int) (s[3] ^ 0x80);
+		  return 4;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#if 0
+      else if (c < 0xfc)
+	{
+	  if (n >= 5)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (c >= 0xf9 || s[1] >= 0x88))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x03) << 24)
+		         | ((unsigned int) (s[1] ^ 0x80) << 18)
+		         | ((unsigned int) (s[2] ^ 0x80) << 12)
+		         | ((unsigned int) (s[3] ^ 0x80) << 6)
+		         | (unsigned int) (s[4] ^ 0x80);
+		  return 5;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xfe)
+	{
+	  if (n >= 6)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (s[5] ^ 0x80) < 0x40
+		  && (c >= 0xfd || s[1] >= 0x84))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x01) << 30)
+		         | ((unsigned int) (s[1] ^ 0x80) << 24)
+		         | ((unsigned int) (s[2] ^ 0x80) << 18)
+		         | ((unsigned int) (s[3] ^ 0x80) << 12)
+		         | ((unsigned int) (s[4] ^ 0x80) << 6)
+		         | (unsigned int) (s[5] ^ 0x80);
+		  return 6;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#endif
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return 1;
+}
+
+#endif
diff --git a/lib/unistr/u8-mbtouc.c b/lib/unistr/u8-mbtouc.c
new file mode 100644
index 000000000..ff624f17d
--- /dev/null
+++ b/lib/unistr/u8-mbtouc.c
@@ -0,0 +1,168 @@
+/* Look at first character in UTF-8 string.
+   Copyright (C) 1999-2002, 2006-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2001.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#if defined IN_LIBUNISTRING
+/* Tell unistr.h to declare u8_mbtouc as 'extern', not 'static inline'.  */
+# include "unistring-notinline.h"
+#endif
+
+/* Specification.  */
+#include "unistr.h"
+
+#if !HAVE_INLINE
+
+int
+u8_mbtouc (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40)
+		{
+		  *puc = ((unsigned int) (c & 0x1f) << 6)
+		         | (unsigned int) (s[1] ^ 0x80);
+		  return 2;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf0)
+	{
+	  if (n >= 3)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (c >= 0xe1 || s[1] >= 0xa0)
+		  && (c != 0xed || s[1] < 0xa0))
+		{
+		  *puc = ((unsigned int) (c & 0x0f) << 12)
+		         | ((unsigned int) (s[1] ^ 0x80) << 6)
+		         | (unsigned int) (s[2] ^ 0x80);
+		  return 3;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf8)
+	{
+	  if (n >= 4)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40
+		  && (c >= 0xf1 || s[1] >= 0x90)
+#if 1
+		  && (c < 0xf4 || (c == 0xf4 && s[1] < 0x90))
+#endif
+		 )
+		{
+		  *puc = ((unsigned int) (c & 0x07) << 18)
+		         | ((unsigned int) (s[1] ^ 0x80) << 12)
+		         | ((unsigned int) (s[2] ^ 0x80) << 6)
+		         | (unsigned int) (s[3] ^ 0x80);
+		  return 4;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#if 0
+      else if (c < 0xfc)
+	{
+	  if (n >= 5)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (c >= 0xf9 || s[1] >= 0x88))
+		{
+		  *puc = ((unsigned int) (c & 0x03) << 24)
+		         | ((unsigned int) (s[1] ^ 0x80) << 18)
+		         | ((unsigned int) (s[2] ^ 0x80) << 12)
+		         | ((unsigned int) (s[3] ^ 0x80) << 6)
+		         | (unsigned int) (s[4] ^ 0x80);
+		  return 5;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xfe)
+	{
+	  if (n >= 6)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (s[5] ^ 0x80) < 0x40
+		  && (c >= 0xfd || s[1] >= 0x84))
+		{
+		  *puc = ((unsigned int) (c & 0x01) << 30)
+		         | ((unsigned int) (s[1] ^ 0x80) << 24)
+		         | ((unsigned int) (s[2] ^ 0x80) << 18)
+		         | ((unsigned int) (s[3] ^ 0x80) << 12)
+		         | ((unsigned int) (s[4] ^ 0x80) << 6)
+		         | (unsigned int) (s[5] ^ 0x80);
+		  return 6;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#endif
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return 1;
+}
+
+#endif
diff --git a/lib/unistr/u8-mbtoucr.c b/lib/unistr/u8-mbtoucr.c
new file mode 100644
index 000000000..dd8335247
--- /dev/null
+++ b/lib/unistr/u8-mbtoucr.c
@@ -0,0 +1,285 @@
+/* Look at first character in UTF-8 string, returning an error code.
+   Copyright (C) 1999-2002, 2006-2007 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2001.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "unistr.h"
+
+int
+u8_mbtoucr (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40)
+		{
+		  *puc = ((unsigned int) (c & 0x1f) << 6)
+		         | (unsigned int) (s[1] ^ 0x80);
+		  return 2;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return -2;
+	    }
+	}
+      else if (c < 0xf0)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40
+		  && (c >= 0xe1 || s[1] >= 0xa0)
+		  && (c != 0xed || s[1] < 0xa0))
+		{
+		  if (n >= 3)
+		    {
+		      if ((s[2] ^ 0x80) < 0x40)
+			{
+			  *puc = ((unsigned int) (c & 0x0f) << 12)
+			         | ((unsigned int) (s[1] ^ 0x80) << 6)
+			         | (unsigned int) (s[2] ^ 0x80);
+			  return 3;
+			}
+		      /* invalid multibyte character */
+		    }
+		  else
+		    {
+		      /* incomplete multibyte character */
+		      *puc = 0xfffd;
+		      return -2;
+		    }
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return -2;
+	    }
+	}
+      else if (c < 0xf8)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40
+		  && (c >= 0xf1 || s[1] >= 0x90)
+#if 1
+		  && (c < 0xf4 || (c == 0xf4 && s[1] < 0x90))
+#endif
+		 )
+		{
+		  if (n >= 3)
+		    {
+		      if ((s[2] ^ 0x80) < 0x40)
+			{
+			  if (n >= 4)
+			    {
+			      if ((s[3] ^ 0x80) < 0x40)
+				{
+				  *puc = ((unsigned int) (c & 0x07) << 18)
+				         | ((unsigned int) (s[1] ^ 0x80) << 12)
+				         | ((unsigned int) (s[2] ^ 0x80) << 6)
+				         | (unsigned int) (s[3] ^ 0x80);
+				  return 4;
+				}
+			      /* invalid multibyte character */
+			    }
+			  else
+			    {
+			      /* incomplete multibyte character */
+			      *puc = 0xfffd;
+			      return -2;
+			    }
+			}
+		      /* invalid multibyte character */
+		    }
+		  else
+		    {
+		      /* incomplete multibyte character */
+		      *puc = 0xfffd;
+		      return -2;
+		    }
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return -2;
+	    }
+	}
+#if 0
+      else if (c < 0xfc)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40
+		  && (c >= 0xf9 || s[1] >= 0x88))
+		{
+		  if (n >= 3)
+		    {
+		      if ((s[2] ^ 0x80) < 0x40)
+			{
+			  if (n >= 4)
+			    {
+			      if ((s[3] ^ 0x80) < 0x40)
+				{
+				  if (n >= 5)
+				    {
+				      if ((s[4] ^ 0x80) < 0x40)
+					{
+					  *puc = ((unsigned int) (c & 0x03) << 24)
+					         | ((unsigned int) (s[1] ^ 0x80) << 18)
+					         | ((unsigned int) (s[2] ^ 0x80) << 12)
+					         | ((unsigned int) (s[3] ^ 0x80) << 6)
+					         | (unsigned int) (s[4] ^ 0x80);
+					  return 5;
+					}
+				      /* invalid multibyte character */
+				    }
+				  else
+				    {
+				      /* incomplete multibyte character */
+				      *puc = 0xfffd;
+				      return -2;
+				    }
+				}
+			      /* invalid multibyte character */
+			    }
+			  else
+			    {
+			      /* incomplete multibyte character */
+			      *puc = 0xfffd;
+			      return -2;
+			    }
+			}
+		      /* invalid multibyte character */
+		    }
+		  else
+		    {
+		      /* incomplete multibyte character */
+		      *puc = 0xfffd;
+		      return -2;
+		    }
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return -2;
+	    }
+	}
+      else if (c < 0xfe)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40
+		  && (c >= 0xfd || s[1] >= 0x84))
+		{
+		  if (n >= 3)
+		    {
+		      if ((s[2] ^ 0x80) < 0x40)
+			{
+			  if (n >= 4)
+			    {
+			      if ((s[3] ^ 0x80) < 0x40)
+				{
+				  if (n >= 5)
+				    {
+				      if ((s[4] ^ 0x80) < 0x40)
+					{
+					  if (n >= 6)
+					    {
+					      if ((s[5] ^ 0x80) < 0x40)
+						{
+						  *puc = ((unsigned int) (c & 0x01) << 30)
+						         | ((unsigned int) (s[1] ^ 0x80) << 24)
+						         | ((unsigned int) (s[2] ^ 0x80) << 18)
+						         | ((unsigned int) (s[3] ^ 0x80) << 12)
+						         | ((unsigned int) (s[4] ^ 0x80) << 6)
+						         | (unsigned int) (s[5] ^ 0x80);
+						  return 6;
+						}
+					      /* invalid multibyte character */
+					    }
+					  else
+					    {
+					      /* incomplete multibyte character */
+					      *puc = 0xfffd;
+					      return -2;
+					    }
+					}
+				      /* invalid multibyte character */
+				    }
+				  else
+				    {
+				      /* incomplete multibyte character */
+				      *puc = 0xfffd;
+				      return -2;
+				    }
+				}
+			      /* invalid multibyte character */
+			    }
+			  else
+			    {
+			      /* incomplete multibyte character */
+			      *puc = 0xfffd;
+			      return -2;
+			    }
+			}
+		      /* invalid multibyte character */
+		    }
+		  else
+		    {
+		      /* incomplete multibyte character */
+		      *puc = 0xfffd;
+		      return -2;
+		    }
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return -2;
+	    }
+	}
+#endif
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return -1;
+}
diff --git a/lib/unistr/u8-prev.c b/lib/unistr/u8-prev.c
new file mode 100644
index 000000000..245d22ff0
--- /dev/null
+++ b/lib/unistr/u8-prev.c
@@ -0,0 +1,93 @@
+/* Iterate over previous character in UTF-8 string.
+   Copyright (C) 2002, 2006-2007 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2002.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "unistr.h"
+
+const uint8_t *
+u8_prev (ucs4_t *puc, const uint8_t *s, const uint8_t *start)
+{
+  /* Keep in sync with unistr.h and utf8-ucs4.c.  */
+  if (s != start)
+    {
+      uint8_t c_1 = s[-1];
+
+      if (c_1 < 0x80)
+	{
+	  *puc = c_1;
+	  return s - 1;
+	}
+#if CONFIG_UNICODE_SAFETY
+      if ((c_1 ^ 0x80) < 0x40)
+#endif
+	if (s - 1 != start)
+	  {
+	    uint8_t c_2 = s[-2];
+
+	    if (c_2 >= 0xc2 && c_2 < 0xe0)
+	      {
+		*puc = ((unsigned int) (c_2 & 0x1f) << 6)
+		       | (unsigned int) (c_1 ^ 0x80);
+		return s - 2;
+	      }
+#if CONFIG_UNICODE_SAFETY
+	    if ((c_2 ^ 0x80) < 0x40)
+#endif
+	      if (s - 2 != start)
+		{
+		  uint8_t c_3 = s[-3];
+
+		  if (c_3 >= 0xe0 && c_3 < 0xf0
+#if CONFIG_UNICODE_SAFETY
+		      && (c_3 >= 0xe1 || c_2 >= 0xa0)
+		      && (c_3 != 0xed || c_2 < 0xa0)
+#endif
+		     )
+		    {
+		      *puc = ((unsigned int) (c_3 & 0x0f) << 12)
+		             | ((unsigned int) (c_2 ^ 0x80) << 6)
+		             | (unsigned int) (c_1 ^ 0x80);
+		      return s - 3;
+		    }
+#if CONFIG_UNICODE_SAFETY
+		  if ((c_3 ^ 0x80) < 0x40)
+#endif
+		    if (s - 3 != start)
+		      {
+			uint8_t c_4 = s[-4];
+
+			if (c_4 >= 0xf0 && c_4 < 0xf8
+#if CONFIG_UNICODE_SAFETY
+			    && (c_4 >= 0xf1 || c_3 >= 0x90)
+			    && (c_4 < 0xf4 || (c_4 == 0xf4 && c_3 < 0x90))
+#endif
+			   )
+			  {
+			    *puc = ((unsigned int) (c_4 & 0x07) << 18)
+			           | ((unsigned int) (c_3 ^ 0x80) << 12)
+			           | ((unsigned int) (c_2 ^ 0x80) << 6)
+			           | (unsigned int) (c_1 ^ 0x80);
+			    return s - 4;
+			  }
+		      }
+		}
+	  }
+    }
+  return NULL;
+}
diff --git a/lib/unistr/u8-uctomb-aux.c b/lib/unistr/u8-uctomb-aux.c
new file mode 100644
index 000000000..c42fa5015
--- /dev/null
+++ b/lib/unistr/u8-uctomb-aux.c
@@ -0,0 +1,69 @@
+/* Conversion UCS-4 to UTF-8.
+   Copyright (C) 2002, 2006-2007 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2002.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "unistr.h"
+
+int
+u8_uctomb_aux (uint8_t *s, ucs4_t uc, int n)
+{
+  int count;
+
+  if (uc < 0x80)
+    /* The case n >= 1 is already handled by the caller.  */
+    return -2;
+  else if (uc < 0x800)
+    count = 2;
+  else if (uc < 0x10000)
+    {
+      if (uc < 0xd800 || uc >= 0xe000)
+	count = 3;
+      else
+	return -1;
+    }
+#if 0
+  else if (uc < 0x200000)
+    count = 4;
+  else if (uc < 0x4000000)
+    count = 5;
+  else if (uc <= 0x7fffffff)
+    count = 6;
+#else
+  else if (uc < 0x110000)
+    count = 4;
+#endif
+  else
+    return -1;
+
+  if (n < count)
+    return -2;
+
+  switch (count) /* note: code falls through cases! */
+    {
+#if 0
+    case 6: s[5] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x4000000;
+    case 5: s[4] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x200000;
+#endif
+    case 4: s[3] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x10000;
+    case 3: s[2] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x800;
+    case 2: s[1] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0xc0;
+  /*case 1:*/ s[0] = uc;
+    }
+  return count;
+}
diff --git a/lib/unistr/u8-uctomb.c b/lib/unistr/u8-uctomb.c
new file mode 100644
index 000000000..33921669e
--- /dev/null
+++ b/lib/unistr/u8-uctomb.c
@@ -0,0 +1,88 @@
+/* Store a character in UTF-8 string.
+   Copyright (C) 2002, 2005-2006, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2002.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#if defined IN_LIBUNISTRING
+/* Tell unistr.h to declare u8_uctomb as 'extern', not 'static inline'.  */
+# include "unistring-notinline.h"
+#endif
+
+/* Specification.  */
+#include "unistr.h"
+
+#if !HAVE_INLINE
+
+int
+u8_uctomb (uint8_t *s, ucs4_t uc, int n)
+{
+  if (uc < 0x80)
+    {
+      if (n > 0)
+	{
+	  s[0] = uc;
+	  return 1;
+	}
+      /* else return -2, below.  */
+    }
+  else
+    {
+      int count;
+
+      if (uc < 0x800)
+	count = 2;
+      else if (uc < 0x10000)
+	{
+	  if (uc < 0xd800 || uc >= 0xe000)
+	    count = 3;
+	  else
+	    return -1;
+	}
+#if 0
+      else if (uc < 0x200000)
+	count = 4;
+      else if (uc < 0x4000000)
+	count = 5;
+      else if (uc <= 0x7fffffff)
+	count = 6;
+#else
+      else if (uc < 0x110000)
+	count = 4;
+#endif
+      else
+	return -1;
+
+      if (n >= count)
+	{
+	  switch (count) /* note: code falls through cases! */
+	    {
+#if 0
+	    case 6: s[5] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x4000000;
+	    case 5: s[4] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x200000;
+#endif
+	    case 4: s[3] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x10000;
+	    case 3: s[2] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x800;
+	    case 2: s[1] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0xc0;
+	  /*case 1:*/ s[0] = uc;
+	    }
+	  return count;
+	}
+    }
+  return -2;
+}
+
+#endif
diff --git a/lib/unitypes.h b/lib/unitypes.h
new file mode 100644
index 000000000..fe8d87735
--- /dev/null
+++ b/lib/unitypes.h
@@ -0,0 +1,26 @@
+/* Elementary types for the GNU UniString library.
+   Copyright (C) 2002, 2005-2006 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _UNITYPES_H
+#define _UNITYPES_H
+
+/* Get uint8_t, uint16_t, uint32_t.  */
+#include <stdint.h>
+
+/* Type representing a Unicode character.  */
+typedef uint32_t ucs4_t;
+
+#endif /* _UNITYPES_H */
diff --git a/libguile.h b/libguile.h
index 40122dfa2..6a6d232f9 100644
--- a/libguile.h
+++ b/libguile.h
@@ -1,7 +1,7 @@
 #ifndef SCM_LIBGUILE_H
 #define SCM_LIBGUILE_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -32,6 +32,7 @@ extern "C" {
 #include "libguile/arbiters.h"
 #include "libguile/async.h"
 #include "libguile/boolean.h"
+#include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/continuations.h"
 #include "libguile/dynl.h"
@@ -75,6 +76,7 @@ extern "C" {
 #include "libguile/procprop.h"
 #include "libguile/properties.h"
 #include "libguile/procs.h"
+#include "libguile/r6rs-ports.h"
 #include "libguile/ramap.h"
 #include "libguile/random.h"
 #include "libguile/read.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 63f2ef2bf..46bc998af 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -106,7 +106,8 @@ guile_LDFLAGS = $(GUILE_CFLAGS)
 libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
 
 libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
-    chars.c continuations.c convert.c debug.c deprecation.c		\
+    bytevectors.c chars.c continuations.c				\
+    convert.c debug.c deprecation.c					\
     deprecated.c discouraged.c dynwind.c eq.c error.c	\
     eval.c evalext.c extensions.c feature.c fluids.c fports.c		\
     futures.c gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c		\
@@ -115,7 +116,8 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
     guardians.c hash.c hashtab.c hooks.c init.c inline.c		\
     ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c		\
     modules.c numbers.c objects.c objprop.c options.c pairs.c ports.c	\
-    print.c procprop.c procs.c properties.c random.c rdelim.c read.c	\
+    print.c procprop.c procs.c properties.c				\
+    r6rs-ports.c random.c rdelim.c read.c				\
     root.c rw.c scmsigs.c script.c simpos.c smob.c sort.c srcprop.c	\
     stackchk.c stacks.c stime.c strings.c srfi-4.c srfi-13.c srfi-14.c	\
     strorder.c strports.c struct.c symbols.c threads.c null-threads.c	\
@@ -134,7 +136,8 @@ libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LDFLAGS =	\
    -module -L$(builddir) -lguile				\
    -version-info @LIBGUILE_I18N_INTERFACE@
 
-DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x	\
+DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x		\
+    bytevectors.x chars.x						\
     continuations.x debug.x deprecation.x deprecated.x discouraged.x	\
     dynl.x dynwind.x eq.x error.x eval.x evalext.x	\
     extensions.x feature.x fluids.x fports.x futures.x gc.x gc-mark.x	\
@@ -143,7 +146,8 @@ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x	\
     hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x	\
     list.x load.x macros.x mallocs.x modules.x numbers.x objects.x	\
     objprop.x options.x pairs.x ports.x print.x procprop.x procs.x	\
-    properties.x random.x rdelim.x read.x root.x rw.x scmsigs.x		\
+    properties.x r6rs-ports.x random.x rdelim.x				\
+    read.x root.x rw.x scmsigs.x					\
     script.x simpos.x smob.x sort.x srcprop.x stackchk.x stacks.x	\
     stime.x strings.x srfi-4.x srfi-13.x srfi-14.x strorder.x		\
     strports.x struct.x symbols.x threads.x throw.x values.x		\
@@ -155,7 +159,8 @@ DOT_X_FILES += frames.x instructions.x objcodes.x programs.x vm.x
 EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
 
 DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc		\
-    boolean.doc chars.doc continuations.doc debug.doc deprecation.doc	\
+    boolean.doc bytevectors.doc chars.doc				\
+    continuations.doc debug.doc deprecation.doc				\
     deprecated.doc discouraged.doc dynl.doc dynwind.doc			\
     eq.doc error.doc eval.doc evalext.doc		\
     extensions.doc feature.doc fluids.doc fports.doc futures.doc	\
@@ -165,7 +170,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc		\
     hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc		\
     list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc	\
     objects.doc objprop.doc options.doc pairs.doc ports.doc print.doc	\
-    procprop.doc procs.doc properties.doc random.doc rdelim.doc		\
+    procprop.doc procs.doc properties.doc r6rs-ports.doc		\
+    random.doc rdelim.doc						\
     read.doc root.doc rw.doc scmsigs.doc script.doc simpos.doc		\
     smob.doc sort.doc srcprop.doc stackchk.doc stacks.doc stime.doc	\
     strings.doc srfi-4.doc srfi-13.doc srfi-14.doc strorder.doc		\
@@ -204,7 +210,7 @@ install-exec-hook:
 ## working.
 noinst_HEADERS = convert.i.c					\
                  conv-integer.i.c conv-uinteger.i.c		\
-                 eval.i.c					\
+                 eval.i.c ieee-754.h				\
                  srfi-4.i.c					\
                  quicksort.i.c                                  \
                  win32-uname.h win32-dirent.h win32-socket.h	\
@@ -223,7 +229,8 @@ pkginclude_HEADERS =
 # These are headers visible as <libguile/mumble.h>.
 modincludedir = $(includedir)/libguile
 modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h	\
-    boolean.h chars.h continuations.h convert.h debug.h debug-malloc.h	\
+    boolean.h bytevectors.h chars.h continuations.h convert.h		\
+    debug.h debug-malloc.h						\
     deprecation.h deprecated.h discouraged.h dynl.h dynwind.h		\
     eq.h error.h eval.h evalext.h extensions.h		\
     feature.h filesys.h fluids.h fports.h futures.h gc.h		\
@@ -232,7 +239,8 @@ modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h	\
     hashtab.h hooks.h i18n.h init.h inline.h ioext.h iselect.h		\
     keywords.h lang.h list.h load.h macros.h mallocs.h modules.h	\
     net_db.h numbers.h objects.h objprop.h options.h pairs.h ports.h	\
-    posix.h regex-posix.h print.h procprop.h procs.h properties.h	\
+    posix.h r6rs-ports.h regex-posix.h print.h				\
+    procprop.h procs.h properties.h					\
     random.h ramap.h rdelim.h read.h root.h rw.h scmsigs.h validate.h	\
     script.h simpos.h smob.h snarf.h socket.h sort.h srcprop.h		\
     stackchk.h stacks.h stime.h strings.h srfi-4.h srfi-13.h srfi-14.h	\
@@ -278,6 +286,8 @@ libpath.h: $(srcdir)/Makefile.in  $(top_builddir)/config.status
 	@echo '#define SCM_PKGDATA_DIR "$(pkgdatadir)"' >> libpath.tmp
 	@echo '#define SCM_LIBRARY_DIR "$(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)"'>>libpath.tmp
 	@echo '#define SCM_SITE_DIR "$(pkgdatadir)/site"' >> libpath.tmp
+	@echo '#define SCM_CCACHE_DIR "$(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/ccache"' >> libpath.tmp
+	@echo '#define SCM_EFFECTIVE_VERSION "$(GUILE_EFFECTIVE_VERSION)"' >> libpath.tmp
 	@echo '#define SCM_BUILD_INFO { \' >> libpath.tmp
 	@echo '	{ "srcdir", "'"`cd @srcdir@; pwd`"'" }, \' >> libpath.tmp
 	@echo ' { "top_srcdir",    "@top_srcdir_absolute@" }, \' >> libpath.tmp
@@ -291,12 +301,13 @@ libpath.h: $(srcdir)/Makefile.in  $(top_builddir)/config.status
 	@echo '	{ "sharedstatedir", "@sharedstatedir@" }, \' >> libpath.tmp
 	@echo '	{ "localstatedir", "@localstatedir@" }, \' >> libpath.tmp
 	@echo '	{ "libdir",	   "@libdir@" }, \' >> libpath.tmp
+	@echo '	{ "ccachedir",	   SCM_CCACHE_DIR }, \' >> libpath.tmp
 	@echo '	{ "infodir",	   "@infodir@" }, \' >> libpath.tmp
 	@echo '	{ "mandir",	   "@mandir@" }, \' >> libpath.tmp
 	@echo '	{ "includedir",	   "@includedir@" }, \' >> libpath.tmp
-	@echo '	{ "pkgdatadir",	   "$(datadir)/@PACKAGE@" }, \' >> libpath.tmp
-	@echo '	{ "pkglibdir",	   "$(libdir)/@PACKAGE@" }, \' >> libpath.tmp
-	@echo '	{ "pkgincludedir", "$(includedir)/@PACKAGE@" }, \' \
+	@echo '	{ "pkgdatadir",	   "@pkgdatadir@" }, \' >> libpath.tmp
+	@echo '	{ "pkglibdir",	   "@pkglibdir@" }, \' >> libpath.tmp
+	@echo '	{ "pkgincludedir", "@pkgincludedir@" }, \' \
 		>> libpath.tmp
 	@echo '	{ "guileversion", "@GUILE_VERSION@" }, \' >> libpath.tmp
 	@echo '	{ "libguileinterface", "@LIBGUILE_INTERFACE@" }, \' \
@@ -326,10 +337,8 @@ error.x: cpp_err_symbols.c
 posix.x: cpp_sig_symbols.c
 load.x: libpath.h
 
-include $(top_srcdir)/am/pre-inst-guile
-
 alldotdocfiles    = $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES)
-snarf2checkedtexi = $(top_builddir)/meta/uninstalled-env guile-tools snarf-check-and-output-texi
+snarf2checkedtexi = GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/uninstalled-env guile-tools snarf-check-and-output-texi
 dotdoc2texi       = cat $(alldotdocfiles) | $(snarf2checkedtexi)
 
 guile.texi: $(alldotdocfiles) guile$(EXEEXT)
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
new file mode 100644
index 000000000..1de4db065
--- /dev/null
+++ b/libguile/bytevectors.c
@@ -0,0 +1,2011 @@
+/* Copyright (C) 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <alloca.h>
+
+#include <gmp.h>
+
+#include "libguile/_scm.h"
+#include "libguile/bytevectors.h"
+#include "libguile/strings.h"
+#include "libguile/validate.h"
+#include "libguile/ieee-754.h"
+#include "libguile/unif.h"
+#include "libguile/srfi-4.h"
+
+#include <byteswap.h>
+#include <striconveh.h>
+#include <uniconv.h>
+
+#ifdef HAVE_LIMITS_H
+# include <limits.h>
+#else
+/* Assuming 32-bit longs.  */
+# define ULONG_MAX 4294967295UL
+#endif
+
+#include <string.h>
+
+
+
+/* Utilities.  */
+
+/* Convenience macros.  These are used by the various templates (macros) that
+   are parameterized by integer signedness.  */
+#define INT8_T_signed           scm_t_int8
+#define INT8_T_unsigned         scm_t_uint8
+#define INT16_T_signed          scm_t_int16
+#define INT16_T_unsigned        scm_t_uint16
+#define INT32_T_signed          scm_t_int32
+#define INT32_T_unsigned        scm_t_uint32
+#define is_signed_int8(_x)      (((_x) >= -128L) && ((_x) <= 127L))
+#define is_unsigned_int8(_x)    ((_x) <= 255UL)
+#define is_signed_int16(_x)     (((_x) >= -32768L) && ((_x) <= 32767L))
+#define is_unsigned_int16(_x)   ((_x) <= 65535UL)
+#define is_signed_int32(_x)     (((_x) >= -2147483648L) && ((_x) <= 2147483647L))
+#define is_unsigned_int32(_x)   ((_x) <= 4294967295UL)
+#define SIGNEDNESS_signed       1
+#define SIGNEDNESS_unsigned     0
+
+#define INT_TYPE(_size, _sign)  INT ## _size ## _T_ ## _sign
+#define INT_SWAP(_size)         bswap_ ## _size
+#define INT_VALID_P(_size, _sign) is_ ## _sign ## _int ## _size
+#define SIGNEDNESS(_sign)       SIGNEDNESS_ ## _sign
+
+
+#define INTEGER_ACCESSOR_PROLOGUE(_len, _sign)			\
+  unsigned c_len, c_index;					\
+  _sign char *c_bv;						\
+								\
+  SCM_VALIDATE_BYTEVECTOR (1, bv);				\
+  c_index = scm_to_uint (index);				\
+								\
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);				\
+  c_bv = (_sign char *) SCM_BYTEVECTOR_CONTENTS (bv);		\
+								\
+  if (SCM_UNLIKELY (c_index + ((_len) >> 3UL) - 1 >= c_len))	\
+    scm_out_of_range (FUNC_NAME, index);
+
+/* Template for fixed-size integer access (only 8, 16 or 32-bit).  */
+#define INTEGER_REF(_len, _sign)			\
+  SCM result;						\
+							\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);		\
+  SCM_VALIDATE_SYMBOL (3, endianness);			\
+							\
+  {							\
+    INT_TYPE (_len, _sign)  c_result;			\
+							\
+    memcpy (&c_result, &c_bv[c_index], (_len) / 8);	\
+    if (!scm_is_eq (endianness, native_endianness))	\
+      c_result = INT_SWAP (_len) (c_result);		\
+							\
+    result = SCM_I_MAKINUM (c_result);			\
+  }							\
+							\
+  return result;
+
+/* Template for fixed-size integer access using the native endianness.  */
+#define INTEGER_NATIVE_REF(_len, _sign)			\
+  SCM result;						\
+							\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);		\
+							\
+  {							\
+    INT_TYPE (_len, _sign)  c_result;			\
+							\
+    memcpy (&c_result, &c_bv[c_index], (_len) / 8);	\
+    result = SCM_I_MAKINUM (c_result);			\
+  }							\
+							\
+  return result;
+
+/* Template for fixed-size integer modification (only 8, 16 or 32-bit).  */
+#define INTEGER_SET(_len, _sign)				\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);			\
+  SCM_VALIDATE_SYMBOL (3, endianness);				\
+								\
+  {								\
+    _sign long c_value;						\
+    INT_TYPE (_len, _sign) c_value_short;			\
+								\
+    if (SCM_UNLIKELY (!SCM_I_INUMP (value)))			\
+      scm_wrong_type_arg (FUNC_NAME, 3, value);			\
+								\
+    c_value = SCM_I_INUM (value);				\
+    if (SCM_UNLIKELY (!INT_VALID_P (_len, _sign) (c_value)))	\
+      scm_out_of_range (FUNC_NAME, value);			\
+								\
+    c_value_short = (INT_TYPE (_len, _sign)) c_value;		\
+    if (!scm_is_eq (endianness, native_endianness))		\
+      c_value_short = INT_SWAP (_len) (c_value_short);		\
+								\
+    memcpy (&c_bv[c_index], &c_value_short, (_len) / 8);	\
+  }								\
+								\
+  return SCM_UNSPECIFIED;
+
+/* Template for fixed-size integer modification using the native
+   endianness.  */
+#define INTEGER_NATIVE_SET(_len, _sign)				\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);			\
+								\
+  {								\
+    _sign long c_value;						\
+    INT_TYPE (_len, _sign) c_value_short;			\
+								\
+    if (SCM_UNLIKELY (!SCM_I_INUMP (value)))			\
+      scm_wrong_type_arg (FUNC_NAME, 3, value);			\
+								\
+    c_value = SCM_I_INUM (value);				\
+    if (SCM_UNLIKELY (!INT_VALID_P (_len, _sign) (c_value)))	\
+      scm_out_of_range (FUNC_NAME, value);			\
+								\
+    c_value_short = (INT_TYPE (_len, _sign)) c_value;		\
+								\
+    memcpy (&c_bv[c_index], &c_value_short, (_len) / 8);	\
+  }								\
+								\
+  return SCM_UNSPECIFIED;
+
+
+
+/* Bytevector type.  */
+
+SCM_GLOBAL_SMOB (scm_tc16_bytevector, "r6rs-bytevector", 0);
+
+#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)	\
+  SCM_SET_SMOB_DATA ((_bv), (scm_t_bits) (_len))
+#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf)	\
+  SCM_SET_SMOB_DATA_2 ((_bv), (scm_t_bits) (_buf))
+
+/* The empty bytevector.  */
+SCM scm_null_bytevector = SCM_UNSPECIFIED;
+
+
+static inline SCM
+make_bytevector_from_buffer (unsigned len, signed char *contents)
+{
+  /* Assuming LEN > SCM_BYTEVECTOR_INLINE_THRESHOLD.  */
+  SCM_RETURN_NEWSMOB2 (scm_tc16_bytevector, len, contents);
+}
+
+static inline SCM
+make_bytevector (unsigned len)
+{
+  SCM bv;
+
+  if (SCM_UNLIKELY (len == 0))
+    bv = scm_null_bytevector;
+  else
+    {
+      signed char *contents = NULL;
+
+      if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
+	contents = (signed char *) scm_gc_malloc (len, SCM_GC_BYTEVECTOR);
+
+      bv = make_bytevector_from_buffer (len, contents);
+    }
+
+  return bv;
+}
+
+/* Return a new bytevector of size LEN octets.  */
+SCM
+scm_c_make_bytevector (unsigned len)
+{
+  return (make_bytevector (len));
+}
+
+/* Return a bytevector of size LEN made up of CONTENTS.  The area pointed to
+   by CONTENTS must have been allocated using `scm_gc_malloc ()'.  */
+SCM
+scm_c_take_bytevector (signed char *contents, unsigned len)
+{
+  SCM bv;
+
+  if (SCM_UNLIKELY (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len)))
+    {
+      /* Copy CONTENTS into an "in-line" buffer, then free CONTENTS.  */
+      signed char *c_bv;
+
+      bv = make_bytevector (len);
+      c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+      memcpy (c_bv, contents, len);
+      scm_gc_free (contents, len, SCM_GC_BYTEVECTOR);
+    }
+  else
+    bv = make_bytevector_from_buffer (len, contents);
+
+  return bv;
+}
+
+/* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
+   size) and return BV.  */
+SCM
+scm_i_shrink_bytevector (SCM bv, unsigned c_new_len)
+{
+  if (!SCM_BYTEVECTOR_INLINE_P (bv))
+    {
+      unsigned c_len;
+      signed char *c_bv, *c_new_bv;
+
+      c_len = SCM_BYTEVECTOR_LENGTH (bv);
+      c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+
+      SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
+
+      if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_new_len))
+	{
+	  /* Copy to the in-line buffer and free the current buffer.  */
+	  c_new_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+	  memcpy (c_new_bv, c_bv, c_new_len);
+	  scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
+	}
+      else
+	{
+	  /* Resize the existing buffer.  */
+	  c_new_bv = scm_gc_realloc (c_bv, c_len, c_new_len,
+				     SCM_GC_BYTEVECTOR);
+	  SCM_BYTEVECTOR_SET_CONTENTS (bv, c_new_bv);
+	}
+    }
+
+  return bv;
+}
+
+SCM_SMOB_PRINT (scm_tc16_bytevector, print_bytevector,
+		bv, port, pstate)
+{
+  unsigned c_len, i;
+  unsigned char *c_bv;
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  scm_puts ("#vu8(", port);
+  for (i = 0; i < c_len; i++)
+    {
+      if (i > 0)
+	scm_putc (' ', port);
+
+      scm_uintprint (c_bv[i], 10, port);
+    }
+
+  scm_putc (')', port);
+
+  /* Make GCC think we use it.  */
+  scm_remember_upto_here ((SCM) pstate);
+
+  return 1;
+}
+
+SCM_SMOB_FREE (scm_tc16_bytevector, free_bytevector, bv)
+{
+
+  if (!SCM_BYTEVECTOR_INLINE_P (bv))
+    {
+      unsigned c_len;
+      signed char *c_bv;
+
+      c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+      c_len = SCM_BYTEVECTOR_LENGTH (bv);
+
+      scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
+    }
+
+  return 0;
+}
+
+
+
+/* General operations.  */
+
+SCM_SYMBOL (scm_sym_big, "big");
+SCM_SYMBOL (scm_sym_little, "little");
+
+SCM scm_endianness_big, scm_endianness_little;
+
+/* Host endianness (a symbol).  */
+static SCM native_endianness = SCM_UNSPECIFIED;
+
+/* Byte-swapping.  */
+#ifndef bswap_24
+# define bswap_24(_x)				\
+  ((((_x) & 0xff0000) >> 16) |			\
+   (((_x) & 0x00ff00))       |			\
+   (((_x) & 0x0000ff) << 16))
+#endif
+
+
+SCM_DEFINE (scm_native_endianness, "native-endianness", 0, 0, 0,
+	    (void),
+	    "Return a symbol denoting the machine's native endianness.")
+#define FUNC_NAME s_scm_native_endianness
+{
+  return native_endianness;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_p, "bytevector?", 1, 0, 0,
+	    (SCM obj),
+	    "Return true if @var{obj} is a bytevector.")
+#define FUNC_NAME s_scm_bytevector_p
+{
+  return (scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_bytevector,
+					     obj)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
+	    (SCM len, SCM fill),
+	    "Return a newly allocated bytevector of @var{len} bytes, "
+	    "optionally filled with @var{fill}.")
+#define FUNC_NAME s_scm_make_bytevector
+{
+  SCM bv;
+  unsigned c_len;
+  signed char c_fill = '\0';
+
+  SCM_VALIDATE_UINT_COPY (1, len, c_len);
+  if (fill != SCM_UNDEFINED)
+    {
+      int value;
+
+      value = scm_to_int (fill);
+      if (SCM_UNLIKELY ((value < -128) || (value > 255)))
+	scm_out_of_range (FUNC_NAME, fill);
+      c_fill = (signed char) value;
+    }
+
+  bv = make_bytevector (c_len);
+  if (fill != SCM_UNDEFINED)
+    {
+      unsigned i;
+      signed char *contents;
+
+      contents = SCM_BYTEVECTOR_CONTENTS (bv);
+      for (i = 0; i < c_len; i++)
+	contents[i] = c_fill;
+    }
+
+  return bv;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_length, "bytevector-length", 1, 0, 0,
+	    (SCM bv),
+	    "Return the length (in bytes) of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_length
+{
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  return (scm_from_uint (SCM_BYTEVECTOR_LENGTH (bv)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_eq_p, "bytevector=?", 2, 0, 0,
+	    (SCM bv1, SCM bv2),
+	    "Return is @var{bv1} equals to @var{bv2}---i.e., if they "
+	    "have the same length and contents.")
+#define FUNC_NAME s_scm_bytevector_eq_p
+{
+  SCM result = SCM_BOOL_F;
+  unsigned c_len1, c_len2;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv1);
+  SCM_VALIDATE_BYTEVECTOR (2, bv2);
+
+  c_len1 = SCM_BYTEVECTOR_LENGTH (bv1);
+  c_len2 = SCM_BYTEVECTOR_LENGTH (bv2);
+
+  if (c_len1 == c_len2)
+    {
+      signed char *c_bv1, *c_bv2;
+
+      c_bv1 = SCM_BYTEVECTOR_CONTENTS (bv1);
+      c_bv2 = SCM_BYTEVECTOR_CONTENTS (bv2);
+
+      result = scm_from_bool (!memcmp (c_bv1, c_bv2, c_len1));
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_fill_x, "bytevector-fill!", 2, 0, 0,
+	    (SCM bv, SCM fill),
+	    "Fill bytevector @var{bv} with @var{fill}, a byte.")
+#define FUNC_NAME s_scm_bytevector_fill_x
+{
+  unsigned c_len, i;
+  signed char *c_bv, c_fill;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+  c_fill = scm_to_int8 (fill);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+
+  for (i = 0; i < c_len; i++)
+    c_bv[i] = c_fill;
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_copy_x, "bytevector-copy!", 5, 0, 0,
+	    (SCM source, SCM source_start, SCM target, SCM target_start,
+	     SCM len),
+	    "Copy @var{len} bytes from @var{source} into @var{target}, "
+	    "starting reading from @var{source_start} (a positive index "
+	    "within @var{source}) and start writing at "
+	    "@var{target_start}.")
+#define FUNC_NAME s_scm_bytevector_copy_x
+{
+  unsigned c_len, c_source_len, c_target_len;
+  unsigned c_source_start, c_target_start;
+  signed char *c_source, *c_target;
+
+  SCM_VALIDATE_BYTEVECTOR (1, source);
+  SCM_VALIDATE_BYTEVECTOR (3, target);
+
+  c_len = scm_to_uint (len);
+  c_source_start = scm_to_uint (source_start);
+  c_target_start = scm_to_uint (target_start);
+
+  c_source = SCM_BYTEVECTOR_CONTENTS (source);
+  c_target = SCM_BYTEVECTOR_CONTENTS (target);
+  c_source_len = SCM_BYTEVECTOR_LENGTH (source);
+  c_target_len = SCM_BYTEVECTOR_LENGTH (target);
+
+  if (SCM_UNLIKELY (c_source_start + c_len > c_source_len))
+    scm_out_of_range (FUNC_NAME, source_start);
+  if (SCM_UNLIKELY (c_target_start + c_len > c_target_len))
+    scm_out_of_range (FUNC_NAME, target_start);
+
+  memcpy (c_target + c_target_start,
+	  c_source + c_source_start,
+	  c_len);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
+	    (SCM bv),
+	    "Return a newly allocated copy of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_copy
+{
+  SCM copy;
+  unsigned c_len;
+  signed char *c_bv, *c_copy;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+
+  copy = make_bytevector (c_len);
+  c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
+  memcpy (c_copy, c_bv, c_len);
+
+  return copy;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
+            1, 0, 0, (SCM array),
+	    "Return a newly allocated bytevector whose contents\n"
+            "will be copied from the uniform array @var{array}.")
+#define FUNC_NAME s_scm_uniform_array_to_bytevector
+{
+  SCM contents, ret;
+  size_t len;
+  scm_t_array_handle h;
+  const void *base;
+  size_t sz;
+  
+  contents = scm_array_contents (array, SCM_BOOL_T);
+  if (scm_is_false (contents))
+    scm_wrong_type_arg_msg (FUNC_NAME, 0, array, "uniform contiguous array");
+
+  scm_array_get_handle (contents, &h);
+
+  base = scm_array_handle_uniform_elements (&h);
+  len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1);
+  sz = scm_array_handle_uniform_element_size (&h);
+
+  ret = make_bytevector (len * sz);
+  memcpy (SCM_BYTEVECTOR_CONTENTS (ret), base, len * sz);
+
+  scm_array_handle_release (&h);
+
+  return ret;
+}
+#undef FUNC_NAME
+
+
+/* Operations on bytes and octets.  */
+
+SCM_DEFINE (scm_bytevector_u8_ref, "bytevector-u8-ref", 2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the octet located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_u8_ref
+{
+  INTEGER_NATIVE_REF (8, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s8_ref, "bytevector-s8-ref", 2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the byte located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_s8_ref
+{
+  INTEGER_NATIVE_REF (8, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u8_set_x, "bytevector-u8-set!", 3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Return the octet located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_u8_set_x
+{
+  INTEGER_NATIVE_SET (8, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s8_set_x, "bytevector-s8-set!", 3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Return the octet located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_s8_set_x
+{
+  INTEGER_NATIVE_SET (8, signed);
+}
+#undef FUNC_NAME
+
+#undef OCTET_ACCESSOR_PROLOGUE
+
+
+SCM_DEFINE (scm_bytevector_to_u8_list, "bytevector->u8-list", 1, 0, 0,
+	    (SCM bv),
+	    "Return a newly allocated list of octets containing the "
+	    "contents of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_to_u8_list
+{
+  SCM lst, pair;
+  unsigned c_len, i;
+  unsigned char *c_bv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  lst = scm_make_list (scm_from_uint (c_len), SCM_UNSPECIFIED);
+  for (i = 0, pair = lst;
+       i < c_len;
+       i++, pair = SCM_CDR (pair))
+    {
+      SCM_SETCAR (pair, SCM_I_MAKINUM (c_bv[i]));
+    }
+
+  return lst;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
+	    (SCM lst),
+	    "Turn @var{lst}, a list of octets, into a bytevector.")
+#define FUNC_NAME s_scm_u8_list_to_bytevector
+{
+  SCM bv, item;
+  long c_len, i;
+  unsigned char *c_bv;
+
+  SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
+
+  bv = make_bytevector (c_len);
+  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
+    {
+      item = SCM_CAR (lst);
+
+      if (SCM_LIKELY (SCM_I_INUMP (item)))
+	{
+	  long c_item;
+
+	  c_item = SCM_I_INUM (item);
+	  if (SCM_LIKELY ((c_item >= 0) && (c_item < 256)))
+	    c_bv[i] = (unsigned char) c_item;
+	  else
+	    goto type_error;
+	}
+      else
+	goto type_error;
+    }
+
+  return bv;
+
+ type_error:
+  scm_wrong_type_arg (FUNC_NAME, 1, item);
+
+  return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+/* Compute the two's complement of VALUE (a positive integer) on SIZE octets
+   using (2^(SIZE * 8) - VALUE).  */
+static inline void
+twos_complement (mpz_t value, size_t size)
+{
+  unsigned long bit_count;
+
+  /* We expect BIT_COUNT to fit in a unsigned long thanks to the range
+     checking on SIZE performed earlier.  */
+  bit_count = (unsigned long) size << 3UL;
+
+  if (SCM_LIKELY (bit_count < sizeof (unsigned long)))
+    mpz_ui_sub (value, 1UL << bit_count, value);
+  else
+    {
+      mpz_t max;
+
+      mpz_init (max);
+      mpz_ui_pow_ui (max, 2, bit_count);
+      mpz_sub (value, max, value);
+      mpz_clear (max);
+    }
+}
+
+static inline SCM
+bytevector_large_ref (const char *c_bv, size_t c_size, int signed_p,
+		      SCM endianness)
+{
+  SCM result;
+  mpz_t c_mpz;
+  int c_endianness, negative_p = 0;
+
+  if (signed_p)
+    {
+      if (scm_is_eq (endianness, scm_sym_big))
+	negative_p = c_bv[0] & 0x80;
+      else
+	negative_p = c_bv[c_size - 1] & 0x80;
+    }
+
+  c_endianness = scm_is_eq (endianness, scm_sym_big) ? 1 : -1;
+
+  mpz_init (c_mpz);
+  mpz_import (c_mpz, 1 /* 1 word */, 1 /* word order doesn't matter */,
+	      c_size /* word is C_SIZE-byte long */,
+	      c_endianness,
+	      0 /* nails */, c_bv);
+
+  if (signed_p && negative_p)
+    {
+      twos_complement (c_mpz, c_size);
+      mpz_neg (c_mpz, c_mpz);
+    }
+
+  result = scm_from_mpz (c_mpz);
+  mpz_clear (c_mpz);  /* FIXME: Needed? */
+
+  return result;
+}
+
+static inline int
+bytevector_large_set (char *c_bv, size_t c_size, int signed_p,
+		      SCM value, SCM endianness)
+{
+  mpz_t c_mpz;
+  int c_endianness, c_sign, err = 0;
+
+  c_endianness = scm_is_eq (endianness, scm_sym_big) ? 1 : -1;
+
+  mpz_init (c_mpz);
+  scm_to_mpz (value, c_mpz);
+
+  c_sign = mpz_sgn (c_mpz);
+  if (c_sign < 0)
+    {
+      if (SCM_LIKELY (signed_p))
+	{
+	  mpz_neg (c_mpz, c_mpz);
+	  twos_complement (c_mpz, c_size);
+	}
+      else
+	{
+	  err = -1;
+	  goto finish;
+	}
+    }
+
+  if (c_sign == 0)
+    /* Zero.  */
+    memset (c_bv, 0, c_size);
+  else
+    {
+      size_t word_count, value_size;
+
+      value_size = (mpz_sizeinbase (c_mpz, 2) + (8 * c_size)) / (8 * c_size);
+      if (SCM_UNLIKELY (value_size > c_size))
+	{
+	  err = -2;
+	  goto finish;
+	}
+
+
+      mpz_export (c_bv, &word_count, 1 /* word order doesn't matter */,
+		  c_size, c_endianness,
+		  0 /* nails */, c_mpz);
+      if (SCM_UNLIKELY (word_count != 1))
+	/* Shouldn't happen since we already checked with VALUE_SIZE.  */
+	abort ();
+    }
+
+ finish:
+  mpz_clear (c_mpz);
+
+  return err;
+}
+
+#define GENERIC_INTEGER_ACCESSOR_PROLOGUE(_sign)			\
+  unsigned long c_len, c_index, c_size;					\
+  char *c_bv;								\
+									\
+  SCM_VALIDATE_BYTEVECTOR (1, bv);					\
+  c_index = scm_to_ulong (index);					\
+  c_size = scm_to_ulong (size);						\
+									\
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);					\
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);				\
+									\
+  /* C_SIZE must have its 3 higher bits set to zero so that		\
+     multiplying it by 8 yields a number that fits in an		\
+     unsigned long.  */							\
+  if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))	\
+    scm_out_of_range (FUNC_NAME, size);					\
+  if (SCM_UNLIKELY (c_index + c_size > c_len))				\
+    scm_out_of_range (FUNC_NAME, index);
+
+
+/* Template of an integer reference function.  */
+#define GENERIC_INTEGER_REF(_sign)					\
+  SCM result;								\
+									\
+  if (c_size < 3)							\
+    {									\
+      int swap;								\
+      _sign int value;							\
+									\
+      swap = !scm_is_eq (endianness, native_endianness);		\
+      switch (c_size)							\
+	{								\
+	case 1:								\
+	  {								\
+	    _sign char c_value8;					\
+	    memcpy (&c_value8, c_bv, 1);				\
+	    value = c_value8;						\
+	  }								\
+	  break;							\
+	case 2:								\
+	  {								\
+	    INT_TYPE (16, _sign)  c_value16;				\
+	    memcpy (&c_value16, c_bv, 2);				\
+	    if (swap)							\
+	      value = (INT_TYPE (16, _sign)) bswap_16 (c_value16);	\
+	    else							\
+	      value = c_value16;					\
+	  }								\
+	  break;							\
+	default:							\
+	  abort ();							\
+	}								\
+									\
+      result = SCM_I_MAKINUM ((_sign int) value);			\
+    }									\
+  else									\
+    result = bytevector_large_ref ((char *) c_bv,			\
+				   c_size, SIGNEDNESS (_sign),		\
+				   endianness);				\
+									\
+  return result;
+
+static inline SCM
+bytevector_signed_ref (const char *c_bv, size_t c_size, SCM endianness)
+{
+  GENERIC_INTEGER_REF (signed);
+}
+
+static inline SCM
+bytevector_unsigned_ref (const char *c_bv, size_t c_size, SCM endianness)
+{
+  GENERIC_INTEGER_REF (unsigned);
+}
+
+
+/* Template of an integer assignment function.  */
+#define GENERIC_INTEGER_SET(_sign)					\
+  if (c_size < 3)							\
+    {									\
+      _sign int c_value;						\
+									\
+      if (SCM_UNLIKELY (!SCM_I_INUMP (value)))				\
+	goto range_error;						\
+									\
+      c_value = SCM_I_INUM (value);					\
+      switch (c_size)							\
+	{								\
+	case 1:								\
+	  if (SCM_LIKELY (INT_VALID_P (8, _sign) (c_value)))		\
+	    {								\
+	      _sign char c_value8;					\
+	      c_value8 = (_sign char) c_value;				\
+	      memcpy (c_bv, &c_value8, 1);				\
+	    }								\
+	  else								\
+	    goto range_error;						\
+	  break;							\
+									\
+	case 2:								\
+	  if (SCM_LIKELY (INT_VALID_P (16, _sign) (c_value)))		\
+	    {								\
+	      int swap;							\
+	      INT_TYPE (16, _sign)  c_value16;				\
+									\
+	      swap = !scm_is_eq (endianness, native_endianness);	\
+									\
+	      if (swap)							\
+		c_value16 = (INT_TYPE (16, _sign)) bswap_16 (c_value);	\
+	      else							\
+		c_value16 = c_value;					\
+									\
+	      memcpy (c_bv, &c_value16, 2);				\
+	    }								\
+	  else								\
+	    goto range_error;						\
+	  break;							\
+									\
+	default:							\
+	  abort ();							\
+	}								\
+    }									\
+  else									\
+    {									\
+      int err;								\
+									\
+      err = bytevector_large_set (c_bv, c_size,				\
+				  SIGNEDNESS (_sign),			\
+				  value, endianness);			\
+      if (err)								\
+	goto range_error;						\
+    }									\
+									\
+  return;								\
+									\
+ range_error:								\
+  scm_out_of_range (FUNC_NAME, value);					\
+  return;
+
+static inline void
+bytevector_signed_set (char *c_bv, size_t c_size,
+		       SCM value, SCM endianness,
+		       const char *func_name)
+#define FUNC_NAME func_name
+{
+  GENERIC_INTEGER_SET (signed);
+}
+#undef FUNC_NAME
+
+static inline void
+bytevector_unsigned_set (char *c_bv, size_t c_size,
+			 SCM value, SCM endianness,
+			 const char *func_name)
+#define FUNC_NAME func_name
+{
+  GENERIC_INTEGER_SET (unsigned);
+}
+#undef FUNC_NAME
+
+#undef GENERIC_INTEGER_SET
+#undef GENERIC_INTEGER_REF
+
+
+SCM_DEFINE (scm_bytevector_uint_ref, "bytevector-uint-ref", 4, 0, 0,
+	    (SCM bv, SCM index, SCM endianness, SCM size),
+	    "Return the @var{size}-octet long unsigned integer at index "
+	    "@var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_uint_ref
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (unsigned);
+
+  return (bytevector_unsigned_ref (&c_bv[c_index], c_size, endianness));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_sint_ref, "bytevector-sint-ref", 4, 0, 0,
+	    (SCM bv, SCM index, SCM endianness, SCM size),
+	    "Return the @var{size}-octet long unsigned integer at index "
+	    "@var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_sint_ref
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (signed);
+
+  return (bytevector_signed_ref (&c_bv[c_index], c_size, endianness));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_uint_set_x, "bytevector-uint-set!", 5, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness, SCM size),
+	    "Set the @var{size}-octet long unsigned integer at @var{index} "
+	    "to @var{value}.")
+#define FUNC_NAME s_scm_bytevector_uint_set_x
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (unsigned);
+
+  bytevector_unsigned_set (&c_bv[c_index], c_size, value, endianness,
+			   FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_sint_set_x, "bytevector-sint-set!", 5, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness, SCM size),
+	    "Set the @var{size}-octet long signed integer at @var{index} "
+	    "to @var{value}.")
+#define FUNC_NAME s_scm_bytevector_sint_set_x
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (signed);
+
+  bytevector_signed_set (&c_bv[c_index], c_size, value, endianness,
+			 FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+
+/* Operations on integers of arbitrary size.  */
+
+#define INTEGERS_TO_LIST(_sign)						\
+  SCM lst, pair;							\
+  size_t i, c_len, c_size;						\
+									\
+  SCM_VALIDATE_BYTEVECTOR (1, bv);					\
+  SCM_VALIDATE_SYMBOL (2, endianness);					\
+  c_size = scm_to_uint (size);						\
+									\
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);					\
+  if (SCM_UNLIKELY (c_len == 0))					\
+    lst = SCM_EOL;							\
+  else if (SCM_UNLIKELY (c_len < c_size))				\
+    scm_out_of_range (FUNC_NAME, size);					\
+  else									\
+    {									\
+      const char *c_bv;							\
+									\
+      c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);			\
+									\
+      lst = scm_make_list (scm_from_uint (c_len / c_size),		\
+			   SCM_UNSPECIFIED);				\
+      for (i = 0, pair = lst;						\
+	   i <= c_len - c_size;						\
+	   i += c_size, c_bv += c_size, pair = SCM_CDR (pair))		\
+	{								\
+	  SCM_SETCAR (pair,						\
+		      bytevector_ ## _sign ## _ref (c_bv, c_size,	\
+						    endianness));	\
+	}								\
+    }									\
+									\
+  return lst;
+
+SCM_DEFINE (scm_bytevector_to_sint_list, "bytevector->sint-list",
+	    3, 0, 0,
+	    (SCM bv, SCM endianness, SCM size),
+	    "Return a list of signed integers of @var{size} octets "
+	    "representing the contents of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_to_sint_list
+{
+  INTEGERS_TO_LIST (signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_to_uint_list, "bytevector->uint-list",
+	    3, 0, 0,
+	    (SCM bv, SCM endianness, SCM size),
+	    "Return a list of unsigned integers of @var{size} octets "
+	    "representing the contents of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_to_uint_list
+{
+  INTEGERS_TO_LIST (unsigned);
+}
+#undef FUNC_NAME
+
+#undef INTEGER_TO_LIST
+
+
+#define INTEGER_LIST_TO_BYTEVECTOR(_sign)				\
+  SCM bv;								\
+  long c_len;								\
+  size_t c_size;							\
+  char *c_bv, *c_bv_ptr;						\
+									\
+  SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);				\
+  SCM_VALIDATE_SYMBOL (2, endianness);					\
+  c_size = scm_to_uint (size);						\
+									\
+  if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))	\
+    scm_out_of_range (FUNC_NAME, size);					\
+									\
+  bv = make_bytevector (c_len * c_size);				\
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);				\
+									\
+  for (c_bv_ptr = c_bv;							\
+       !scm_is_null (lst);						\
+       lst = SCM_CDR (lst), c_bv_ptr += c_size)				\
+    {									\
+      bytevector_ ## _sign ## _set (c_bv_ptr, c_size,			\
+				    SCM_CAR (lst), endianness,		\
+				    FUNC_NAME);				\
+    }									\
+									\
+  return bv;
+
+
+SCM_DEFINE (scm_uint_list_to_bytevector, "uint-list->bytevector",
+	    3, 0, 0,
+	    (SCM lst, SCM endianness, SCM size),
+	    "Return a bytevector containing the unsigned integers "
+	    "listed in @var{lst} and encoded on @var{size} octets "
+	    "according to @var{endianness}.")
+#define FUNC_NAME s_scm_uint_list_to_bytevector
+{
+  INTEGER_LIST_TO_BYTEVECTOR (unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_sint_list_to_bytevector, "sint-list->bytevector",
+	    3, 0, 0,
+	    (SCM lst, SCM endianness, SCM size),
+	    "Return a bytevector containing the signed integers "
+	    "listed in @var{lst} and encoded on @var{size} octets "
+	    "according to @var{endianness}.")
+#define FUNC_NAME s_scm_sint_list_to_bytevector
+{
+  INTEGER_LIST_TO_BYTEVECTOR (signed);
+}
+#undef FUNC_NAME
+
+#undef INTEGER_LIST_TO_BYTEVECTOR
+
+
+
+/* Operations on 16-bit integers.  */
+
+SCM_DEFINE (scm_bytevector_u16_ref, "bytevector-u16-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the unsigned 16-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_u16_ref
+{
+  INTEGER_REF (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_ref, "bytevector-s16-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the signed 16-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_s16_ref
+{
+  INTEGER_REF (16, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u16_native_ref, "bytevector-u16-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 16-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u16_native_ref
+{
+  INTEGER_NATIVE_REF (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_native_ref, "bytevector-s16-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 16-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s16_native_ref
+{
+  INTEGER_NATIVE_REF (16, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u16_set_x, "bytevector-u16-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_u16_set_x
+{
+  INTEGER_SET (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_set_x, "bytevector-s16-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_s16_set_x
+{
+  INTEGER_SET (16, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u16_native_set_x, "bytevector-u16-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the unsigned integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u16_native_set_x
+{
+  INTEGER_NATIVE_SET (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_native_set_x, "bytevector-s16-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the signed integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s16_native_set_x
+{
+  INTEGER_NATIVE_SET (16, signed);
+}
+#undef FUNC_NAME
+
+
+
+/* Operations on 32-bit integers.  */
+
+/* Unfortunately, on 32-bit machines `SCM' is not large enough to hold
+   arbitrary 32-bit integers.  Thus we fall back to using the
+   `large_{ref,set}' variants on 32-bit machines.  */
+
+#define LARGE_INTEGER_REF(_len, _sign)					\
+  INTEGER_ACCESSOR_PROLOGUE(_len, _sign);				\
+  SCM_VALIDATE_SYMBOL (3, endianness);					\
+									\
+  return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8,	\
+				SIGNEDNESS (_sign), endianness));
+
+#define LARGE_INTEGER_SET(_len, _sign)					\
+  int err;								\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);				\
+  SCM_VALIDATE_SYMBOL (4, endianness);					\
+									\
+  err = bytevector_large_set ((char *) c_bv + c_index, _len / 8,	\
+			      SIGNEDNESS (_sign), value, endianness);	\
+  if (SCM_UNLIKELY (err))						\
+     scm_out_of_range (FUNC_NAME, value);				\
+									\
+  return SCM_UNSPECIFIED;
+
+#define LARGE_INTEGER_NATIVE_REF(_len, _sign)				 \
+  INTEGER_ACCESSOR_PROLOGUE(_len, _sign);				 \
+  return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8,	 \
+				SIGNEDNESS (_sign), native_endianness));
+
+#define LARGE_INTEGER_NATIVE_SET(_len, _sign)				\
+  int err;								\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);				\
+									\
+  err = bytevector_large_set ((char *) c_bv + c_index, _len / 8,	\
+			      SIGNEDNESS (_sign), value,		\
+			      native_endianness);			\
+  if (SCM_UNLIKELY (err))						\
+     scm_out_of_range (FUNC_NAME, value);				\
+									\
+  return SCM_UNSPECIFIED;
+
+
+SCM_DEFINE (scm_bytevector_u32_ref, "bytevector-u32-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the unsigned 32-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_u32_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_REF (32, unsigned);
+#else
+  LARGE_INTEGER_REF (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_ref, "bytevector-s32-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the signed 32-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_s32_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_REF (32, signed);
+#else
+  LARGE_INTEGER_REF (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u32_native_ref, "bytevector-u32-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 32-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u32_native_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_REF (32, unsigned);
+#else
+  LARGE_INTEGER_NATIVE_REF (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_native_ref, "bytevector-s32-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 32-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s32_native_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_REF (32, signed);
+#else
+  LARGE_INTEGER_NATIVE_REF (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u32_set_x, "bytevector-u32-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_u32_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_SET (32, unsigned);
+#else
+  LARGE_INTEGER_SET (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_set_x, "bytevector-s32-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_s32_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_SET (32, signed);
+#else
+  LARGE_INTEGER_SET (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u32_native_set_x, "bytevector-u32-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the unsigned integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u32_native_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_SET (32, unsigned);
+#else
+  LARGE_INTEGER_NATIVE_SET (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_native_set_x, "bytevector-s32-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the signed integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s32_native_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_SET (32, signed);
+#else
+  LARGE_INTEGER_NATIVE_SET (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+
+
+/* Operations on 64-bit integers.  */
+
+/* For 64-bit integers, we use only the `large_{ref,set}' variant.  */
+
+SCM_DEFINE (scm_bytevector_u64_ref, "bytevector-u64-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the unsigned 64-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_u64_ref
+{
+  LARGE_INTEGER_REF (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_ref, "bytevector-s64-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the signed 64-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_s64_ref
+{
+  LARGE_INTEGER_REF (64, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u64_native_ref, "bytevector-u64-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 64-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u64_native_ref
+{
+  LARGE_INTEGER_NATIVE_REF (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_native_ref, "bytevector-s64-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 64-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s64_native_ref
+{
+  LARGE_INTEGER_NATIVE_REF (64, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u64_set_x, "bytevector-u64-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_u64_set_x
+{
+  LARGE_INTEGER_SET (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_set_x, "bytevector-s64-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_s64_set_x
+{
+  LARGE_INTEGER_SET (64, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u64_native_set_x, "bytevector-u64-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the unsigned integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u64_native_set_x
+{
+  LARGE_INTEGER_NATIVE_SET (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_native_set_x, "bytevector-s64-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the signed integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s64_native_set_x
+{
+  LARGE_INTEGER_NATIVE_SET (64, signed);
+}
+#undef FUNC_NAME
+
+
+
+/* Operations on IEEE-754 numbers.  */
+
+/* There are two possible word endians, visible in glibc's <ieee754.h>.
+   However, in R6RS, when the endianness is `little', little endian is
+   assumed for both the byte order and the word order.  This is clear from
+   Section 2.1 of R6RS-lib (in response to
+   http://www.r6rs.org/formal-comments/comment-187.txt).  */
+
+
+/* Convert to/from a floating-point number with different endianness.  This
+   method is probably not the most efficient but it should be portable.  */
+
+static inline void
+float_to_foreign_endianness (union scm_ieee754_float *target,
+			     float source)
+{
+  union scm_ieee754_float src;
+
+  src.f = source;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  target->little_endian.negative = src.big_endian.negative;
+  target->little_endian.exponent = src.big_endian.exponent;
+  target->little_endian.mantissa = src.big_endian.mantissa;
+#else
+  target->big_endian.negative = src.little_endian.negative;
+  target->big_endian.exponent = src.little_endian.exponent;
+  target->big_endian.mantissa = src.little_endian.mantissa;
+#endif
+}
+
+static inline float
+float_from_foreign_endianness (const union scm_ieee754_float *source)
+{
+  union scm_ieee754_float result;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  result.big_endian.negative = source->little_endian.negative;
+  result.big_endian.exponent = source->little_endian.exponent;
+  result.big_endian.mantissa = source->little_endian.mantissa;
+#else
+  result.little_endian.negative = source->big_endian.negative;
+  result.little_endian.exponent = source->big_endian.exponent;
+  result.little_endian.mantissa = source->big_endian.mantissa;
+#endif
+
+  return (result.f);
+}
+
+static inline void
+double_to_foreign_endianness (union scm_ieee754_double *target,
+			      double source)
+{
+  union scm_ieee754_double src;
+
+  src.d = source;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  target->little_little_endian.negative  = src.big_endian.negative;
+  target->little_little_endian.exponent  = src.big_endian.exponent;
+  target->little_little_endian.mantissa0 = src.big_endian.mantissa0;
+  target->little_little_endian.mantissa1 = src.big_endian.mantissa1;
+#else
+  target->big_endian.negative  = src.little_little_endian.negative;
+  target->big_endian.exponent  = src.little_little_endian.exponent;
+  target->big_endian.mantissa0 = src.little_little_endian.mantissa0;
+  target->big_endian.mantissa1 = src.little_little_endian.mantissa1;
+#endif
+}
+
+static inline double
+double_from_foreign_endianness (const union scm_ieee754_double *source)
+{
+  union scm_ieee754_double result;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  result.big_endian.negative  = source->little_little_endian.negative;
+  result.big_endian.exponent  = source->little_little_endian.exponent;
+  result.big_endian.mantissa0 = source->little_little_endian.mantissa0;
+  result.big_endian.mantissa1 = source->little_little_endian.mantissa1;
+#else
+  result.little_little_endian.negative  = source->big_endian.negative;
+  result.little_little_endian.exponent  = source->big_endian.exponent;
+  result.little_little_endian.mantissa0 = source->big_endian.mantissa0;
+  result.little_little_endian.mantissa1 = source->big_endian.mantissa1;
+#endif
+
+  return (result.d);
+}
+
+/* Template macros to abstract over doubles and floats.
+   XXX: Guile can only convert to/from doubles.  */
+#define IEEE754_UNION(_c_type)           union scm_ieee754_ ## _c_type
+#define IEEE754_TO_SCM(_c_type)          scm_from_double
+#define IEEE754_FROM_SCM(_c_type)        scm_to_double
+#define IEEE754_FROM_FOREIGN_ENDIANNESS(_c_type)	\
+   _c_type ## _from_foreign_endianness
+#define IEEE754_TO_FOREIGN_ENDIANNESS(_c_type)	\
+   _c_type ## _to_foreign_endianness
+
+
+/* Templace getters and setters.  */
+
+#define IEEE754_ACCESSOR_PROLOGUE(_type)			\
+  INTEGER_ACCESSOR_PROLOGUE (sizeof (_type) << 3UL, signed);
+
+#define IEEE754_REF(_type)					\
+  _type c_result;						\
+								\
+  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+  SCM_VALIDATE_SYMBOL (3, endianness);				\
+								\
+  if (scm_is_eq (endianness, native_endianness))		\
+    memcpy (&c_result, &c_bv[c_index], sizeof (c_result));	\
+  else								\
+    {								\
+      IEEE754_UNION (_type) c_raw;				\
+								\
+      memcpy (&c_raw, &c_bv[c_index], sizeof (c_raw));		\
+      c_result =						\
+	IEEE754_FROM_FOREIGN_ENDIANNESS (_type) (&c_raw);	\
+    }								\
+								\
+  return (IEEE754_TO_SCM (_type) (c_result));
+
+#define IEEE754_NATIVE_REF(_type)				\
+  _type c_result;						\
+								\
+  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+								\
+  memcpy (&c_result, &c_bv[c_index], sizeof (c_result));	\
+  return (IEEE754_TO_SCM (_type) (c_result));
+
+#define IEEE754_SET(_type)					\
+  _type c_value;						\
+								\
+  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+  SCM_VALIDATE_REAL (3, value);					\
+  SCM_VALIDATE_SYMBOL (4, endianness);				\
+  c_value = IEEE754_FROM_SCM (_type) (value);			\
+								\
+  if (scm_is_eq (endianness, native_endianness))		\
+    memcpy (&c_bv[c_index], &c_value, sizeof (c_value));	\
+  else								\
+    {								\
+      IEEE754_UNION (_type) c_raw;				\
+								\
+      IEEE754_TO_FOREIGN_ENDIANNESS (_type) (&c_raw, c_value);	\
+      memcpy (&c_bv[c_index], &c_raw, sizeof (c_raw));		\
+    }								\
+								\
+  return SCM_UNSPECIFIED;
+
+#define IEEE754_NATIVE_SET(_type)			\
+  _type c_value;					\
+							\
+  IEEE754_ACCESSOR_PROLOGUE (_type);			\
+  SCM_VALIDATE_REAL (3, value);				\
+  c_value = IEEE754_FROM_SCM (_type) (value);		\
+							\
+  memcpy (&c_bv[c_index], &c_value, sizeof (c_value));	\
+  return SCM_UNSPECIFIED;
+
+
+/* Single precision.  */
+
+SCM_DEFINE (scm_bytevector_ieee_single_ref,
+	    "bytevector-ieee-single-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the IEEE-754 single from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_ref
+{
+  IEEE754_REF (float);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_single_native_ref,
+	    "bytevector-ieee-single-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the IEEE-754 single from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_native_ref
+{
+  IEEE754_NATIVE_REF (float);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_single_set_x,
+	    "bytevector-ieee-single-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store real @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_set_x
+{
+  IEEE754_SET (float);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_single_native_set_x,
+	    "bytevector-ieee-single-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the real @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_native_set_x
+{
+  IEEE754_NATIVE_SET (float);
+}
+#undef FUNC_NAME
+
+
+/* Double precision.  */
+
+SCM_DEFINE (scm_bytevector_ieee_double_ref,
+	    "bytevector-ieee-double-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the IEEE-754 double from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_ref
+{
+  IEEE754_REF (double);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_double_native_ref,
+	    "bytevector-ieee-double-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the IEEE-754 double from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_native_ref
+{
+  IEEE754_NATIVE_REF (double);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_double_set_x,
+	    "bytevector-ieee-double-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store real @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_set_x
+{
+  IEEE754_SET (double);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_double_native_set_x,
+	    "bytevector-ieee-double-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the real @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_native_set_x
+{
+  IEEE754_NATIVE_SET (double);
+}
+#undef FUNC_NAME
+
+
+#undef IEEE754_UNION
+#undef IEEE754_TO_SCM
+#undef IEEE754_FROM_SCM
+#undef IEEE754_FROM_FOREIGN_ENDIANNESS
+#undef IEEE754_TO_FOREIGN_ENDIANNESS
+#undef IEEE754_REF
+#undef IEEE754_NATIVE_REF
+#undef IEEE754_SET
+#undef IEEE754_NATIVE_SET
+
+
+/* Operations on strings.  */
+
+
+/* Produce a function that returns the length of a UTF-encoded string.  */
+#define UTF_STRLEN_FUNCTION(_utf_width)					\
+static inline size_t							\
+utf ## _utf_width ## _strlen (const uint ## _utf_width ## _t *str)	\
+{									\
+  size_t len = 0;							\
+  const uint ## _utf_width ## _t *ptr;					\
+  for (ptr = str;							\
+       *ptr != 0;							\
+       ptr++)								\
+    {									\
+      len++;								\
+    }									\
+									\
+  return (len * ((_utf_width) / 8));					\
+}
+
+UTF_STRLEN_FUNCTION (8)
+
+
+/* Return the length (in bytes) of STR, a UTF-(UTF_WIDTH) encoded string.  */
+#define UTF_STRLEN(_utf_width, _str)		\
+  utf ## _utf_width ## _strlen (_str)
+
+/* Return the "portable" name of the UTF encoding of size UTF_WIDTH and
+   ENDIANNESS (Gnulib's `iconv_open' module guarantees the portability of the
+   encoding name).  */
+static inline void
+utf_encoding_name (char *name, size_t utf_width, SCM endianness)
+{
+  strcpy (name, "UTF-");
+  strcat (name, ((utf_width == 8)
+		 ? "8"
+		 : ((utf_width == 16)
+		    ? "16"
+		    : ((utf_width == 32)
+		       ? "32"
+		       : "??"))));
+  strcat (name,
+	  ((scm_is_eq (endianness, scm_sym_big))
+	   ? "BE"
+	   : ((scm_is_eq (endianness, scm_sym_little))
+	      ? "LE"
+	      : "unknown")));
+}
+
+/* Maximum length of a UTF encoding name.  */
+#define MAX_UTF_ENCODING_NAME_LEN  16
+
+/* Produce the body of a `string->utf' function.  */
+#define STRING_TO_UTF(_utf_width)					\
+  SCM utf;								\
+  int err;								\
+  char *c_str;								\
+  char c_utf_name[MAX_UTF_ENCODING_NAME_LEN];				\
+  char *c_utf = NULL, *c_locale;					\
+  size_t c_strlen, c_raw_strlen, c_utf_len = 0;				\
+									\
+  SCM_VALIDATE_STRING (1, str);						\
+  if (endianness == SCM_UNDEFINED)					\
+    endianness = scm_sym_big;						\
+  else									\
+    SCM_VALIDATE_SYMBOL (2, endianness);				\
+									\
+  c_strlen = scm_c_string_length (str);					\
+  c_raw_strlen = c_strlen * ((_utf_width) / 8);				\
+  do									\
+    {									\
+      c_str = (char *) alloca (c_raw_strlen + 1);			\
+      c_raw_strlen = scm_to_locale_stringbuf (str, c_str, c_strlen);	\
+    }									\
+  while (c_raw_strlen > c_strlen);					\
+  c_str[c_raw_strlen] = '\0';						\
+									\
+  utf_encoding_name (c_utf_name, (_utf_width), endianness);		\
+									\
+  c_locale = (char *) alloca (strlen (locale_charset ()) + 1);		\
+  strcpy (c_locale, locale_charset ());					\
+									\
+  err = mem_iconveh (c_str, c_raw_strlen,				\
+		     c_locale, c_utf_name,				\
+		     iconveh_question_mark, NULL,			\
+		     &c_utf, &c_utf_len);				\
+  if (SCM_UNLIKELY (err))						\
+    scm_syserror_msg (FUNC_NAME, "failed to convert string: ~A",	\
+		      scm_list_1 (str), err);				\
+  else									\
+    /* C_UTF is null-terminated.  */					\
+    utf = scm_c_take_bytevector ((signed char *) c_utf,			\
+				      c_utf_len);			\
+									\
+  return (utf);
+
+
+
+SCM_DEFINE (scm_string_to_utf8, "string->utf8",
+	    1, 0, 0,
+	    (SCM str),
+	    "Return a newly allocated bytevector that contains the UTF-8 "
+	    "encoding of @var{str}.")
+#define FUNC_NAME s_scm_string_to_utf8
+{
+  SCM utf;
+  char *c_str;
+  uint8_t *c_utf;
+  size_t c_strlen, c_raw_strlen;
+
+  SCM_VALIDATE_STRING (1, str);
+
+  c_strlen = scm_c_string_length (str);
+  c_raw_strlen = c_strlen;
+  do
+    {
+      c_str = (char *) alloca (c_raw_strlen + 1);
+      c_raw_strlen = scm_to_locale_stringbuf (str, c_str, c_strlen);
+    }
+  while (c_raw_strlen > c_strlen);
+  c_str[c_raw_strlen] = '\0';
+
+  c_utf = u8_strconv_from_locale (c_str);
+  if (SCM_UNLIKELY (c_utf == NULL))
+    scm_syserror (FUNC_NAME);
+  else
+    /* C_UTF is null-terminated.  */
+    utf = scm_c_take_bytevector ((signed char *) c_utf,
+				      UTF_STRLEN (8, c_utf));
+
+  return (utf);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_to_utf16, "string->utf16",
+	    1, 1, 0,
+	    (SCM str, SCM endianness),
+	    "Return a newly allocated bytevector that contains the UTF-16 "
+	    "encoding of @var{str}.")
+#define FUNC_NAME s_scm_string_to_utf16
+{
+  STRING_TO_UTF (16);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_to_utf32, "string->utf32",
+	    1, 1, 0,
+	    (SCM str, SCM endianness),
+	    "Return a newly allocated bytevector that contains the UTF-32 "
+	    "encoding of @var{str}.")
+#define FUNC_NAME s_scm_string_to_utf32
+{
+  STRING_TO_UTF (32);
+}
+#undef FUNC_NAME
+
+
+/* Produce the body of a function that converts a UTF-encoded bytevector to a
+   string.  */
+#define UTF_TO_STRING(_utf_width)					\
+  SCM str = SCM_BOOL_F;							\
+  int err;								\
+  char *c_str = NULL, *c_locale;					\
+  char c_utf_name[MAX_UTF_ENCODING_NAME_LEN];				\
+  const char *c_utf;							\
+  size_t c_strlen = 0, c_utf_len;					\
+									\
+  SCM_VALIDATE_BYTEVECTOR (1, utf);					\
+  if (endianness == SCM_UNDEFINED)					\
+    endianness = scm_sym_big;						\
+  else									\
+    SCM_VALIDATE_SYMBOL (2, endianness);				\
+									\
+  c_utf_len = SCM_BYTEVECTOR_LENGTH (utf);				\
+  c_utf = (char *) SCM_BYTEVECTOR_CONTENTS (utf);			\
+  utf_encoding_name (c_utf_name, (_utf_width), endianness);		\
+									\
+  c_locale = (char *) alloca (strlen (locale_charset ()) + 1);		\
+  strcpy (c_locale, locale_charset ());					\
+									\
+  err = mem_iconveh (c_utf, c_utf_len,					\
+		     c_utf_name, c_locale,				\
+		     iconveh_question_mark, NULL,			\
+		     &c_str, &c_strlen);				\
+  if (SCM_UNLIKELY (err))						\
+    scm_syserror_msg (FUNC_NAME, "failed to convert to string: ~A",	\
+		      scm_list_1 (utf), err);				\
+  else									\
+    /* C_STR is null-terminated.  */					\
+    str = scm_take_locale_stringn (c_str, c_strlen);			\
+									\
+  return (str);
+
+
+SCM_DEFINE (scm_utf8_to_string, "utf8->string",
+	    1, 0, 0,
+	    (SCM utf),
+	    "Return a newly allocate string that contains from the UTF-8-"
+	    "encoded contents of bytevector @var{utf}.")
+#define FUNC_NAME s_scm_utf8_to_string
+{
+  SCM str;
+  int err;
+  char *c_str = NULL, *c_locale;
+  const char *c_utf;
+  size_t c_utf_len, c_strlen = 0;
+
+  SCM_VALIDATE_BYTEVECTOR (1, utf);
+
+  c_utf_len = SCM_BYTEVECTOR_LENGTH (utf);
+
+  c_locale = (char *) alloca (strlen (locale_charset ()) + 1);
+  strcpy (c_locale, locale_charset ());
+
+  c_utf = (char *) SCM_BYTEVECTOR_CONTENTS (utf);
+  err = mem_iconveh (c_utf, c_utf_len,
+		     "UTF-8", c_locale,
+		     iconveh_question_mark, NULL,
+		     &c_str, &c_strlen);
+  if (SCM_UNLIKELY (err))
+    scm_syserror_msg (FUNC_NAME, "failed to convert to string: ~A",
+		      scm_list_1 (utf), err);
+  else
+    /* C_STR is null-terminated.  */
+    str = scm_take_locale_stringn (c_str, c_strlen);
+
+  return (str);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_utf16_to_string, "utf16->string",
+	    1, 1, 0,
+	    (SCM utf, SCM endianness),
+	    "Return a newly allocate string that contains from the UTF-16-"
+	    "encoded contents of bytevector @var{utf}.")
+#define FUNC_NAME s_scm_utf16_to_string
+{
+  UTF_TO_STRING (16);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_utf32_to_string, "utf32->string",
+	    1, 1, 0,
+	    (SCM utf, SCM endianness),
+	    "Return a newly allocate string that contains from the UTF-32-"
+	    "encoded contents of bytevector @var{utf}.")
+#define FUNC_NAME s_scm_utf32_to_string
+{
+  UTF_TO_STRING (32);
+}
+#undef FUNC_NAME
+
+
+
+/* Initialization.  */
+
+void
+scm_init_bytevectors (void)
+{
+#include "libguile/bytevectors.x"
+
+#ifdef WORDS_BIGENDIAN
+  native_endianness = scm_sym_big;
+#else
+  native_endianness = scm_sym_little;
+#endif
+
+  scm_endianness_big = scm_sym_big;
+  scm_endianness_little = scm_sym_little;
+
+  scm_null_bytevector =
+    scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
+}
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
new file mode 100644
index 000000000..b01116ce6
--- /dev/null
+++ b/libguile/bytevectors.h
@@ -0,0 +1,135 @@
+#ifndef SCM_BYTEVECTORS_H
+#define SCM_BYTEVECTORS_H
+
+/* Copyright (C) 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 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
+ */
+
+
+
+#include "libguile/__scm.h"
+
+
+/* R6RS bytevectors.  */
+
+#define SCM_BYTEVECTOR_LENGTH(_bv)		\
+  ((unsigned) SCM_SMOB_DATA (_bv))
+#define SCM_BYTEVECTOR_CONTENTS(_bv)		\
+  (SCM_BYTEVECTOR_INLINE_P (_bv)			\
+   ? (signed char *) SCM_SMOB_OBJECT_2_LOC (_bv)	\
+   : (signed char *) SCM_SMOB_DATA_2 (_bv))
+
+
+SCM_API SCM scm_endianness_big;
+SCM_API SCM scm_endianness_little;
+
+SCM_API SCM scm_make_bytevector (SCM, SCM);
+SCM_API SCM scm_c_make_bytevector (unsigned);
+SCM_API SCM scm_native_endianness (void);
+SCM_API SCM scm_bytevector_p (SCM);
+SCM_API SCM scm_bytevector_length (SCM);
+SCM_API SCM scm_bytevector_eq_p (SCM, SCM);
+SCM_API SCM scm_bytevector_fill_x (SCM, SCM);
+SCM_API SCM scm_bytevector_copy_x (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_copy (SCM);
+
+SCM_API SCM scm_uniform_array_to_bytevector (SCM);
+
+SCM_API SCM scm_bytevector_to_u8_list (SCM);
+SCM_API SCM scm_u8_list_to_bytevector (SCM);
+SCM_API SCM scm_uint_list_to_bytevector (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_to_uint_list (SCM, SCM, SCM);
+SCM_API SCM scm_sint_list_to_bytevector (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_to_sint_list (SCM, SCM, SCM);
+
+SCM_API SCM scm_bytevector_u16_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s16_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_u32_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s32_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_u64_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s64_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_u8_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s8_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_uint_ref (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_sint_ref (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u16_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s16_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u32_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s32_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u64_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s64_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u16_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s16_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u32_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s32_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u64_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s64_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u8_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s8_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_uint_set_x (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_sint_set_x (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u16_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s16_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u32_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s32_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u64_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s64_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_string_to_utf8 (SCM);
+SCM_API SCM scm_string_to_utf16 (SCM, SCM);
+SCM_API SCM scm_string_to_utf32 (SCM, SCM);
+SCM_API SCM scm_utf8_to_string (SCM);
+SCM_API SCM scm_utf16_to_string (SCM, SCM);
+SCM_API SCM scm_utf32_to_string (SCM, SCM);
+
+
+
+/* Internal API.  */
+
+/* The threshold (in octets) under which bytevectors are stored "in-line",
+   i.e., without allocating memory beside the SMOB itself (a double cell).
+   This optimization is necessary since small bytevectors are expected to be
+   common.  */
+#define SCM_BYTEVECTOR_INLINE_THRESHOLD  (2 * sizeof (SCM))
+#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size)	\
+  ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
+#define SCM_BYTEVECTOR_INLINE_P(_bv)				     \
+  (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (SCM_BYTEVECTOR_LENGTH (_bv)))
+
+/* Hint that is passed to `scm_gc_malloc ()' and friends.  */
+#define SCM_GC_BYTEVECTOR "bytevector"
+
+SCM_API void scm_init_bytevectors (void);
+
+SCM_INTERNAL scm_t_bits scm_tc16_bytevector;
+SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, unsigned);
+
+#define scm_c_shrink_bytevector(_bv, _len)		\
+  (SCM_BYTEVECTOR_INLINE_P (_bv)			\
+   ? (_bv)						\
+   : scm_i_shrink_bytevector ((_bv), (_len)))
+
+SCM_INTERNAL SCM scm_i_shrink_bytevector (SCM, unsigned);
+SCM_INTERNAL SCM scm_null_bytevector;
+
+#endif /* SCM_BYTEVECTORS_H */
diff --git a/libguile/filesys.c b/libguile/filesys.c
index ec33328b1..4799dd4b1 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -580,17 +580,23 @@ static int fstat_Win32 (int fdes, struct stat *buf)
 }
 #endif /* __MINGW32__ */
 
-SCM_DEFINE (scm_stat, "stat", 1, 0, 0, 
-            (SCM object),
+SCM_DEFINE (scm_stat, "stat", 1, 1, 0, 
+            (SCM object, SCM exception_on_error),
 	    "Return an object containing various information about the file\n"
 	    "determined by @var{obj}.  @var{obj} can be a string containing\n"
 	    "a file name or a port or integer file descriptor which is open\n"
 	    "on a file (in which case @code{fstat} is used as the underlying\n"
 	    "system call).\n"
 	    "\n"
-	    "The object returned by @code{stat} can be passed as a single\n"
-	    "parameter to the following procedures, all of which return\n"
-	    "integers:\n"
+            "If the optional @var{exception_on_error} argument is true, which\n"
+            "is the default, an exception will be raised if the underlying\n"
+            "system call returns an error, for example if the file is not\n"
+            "found or is not readable. Otherwise, an error will cause\n"
+            "@code{stat} to return @code{#f}."
+	    "\n"
+	    "The object returned by a successful call to @code{stat} can be\n"
+            "passed as a single parameter to the following procedures, all of\n"
+            "which return integers:\n"
 	    "\n"
 	    "@table @code\n"
 	    "@item stat:dev\n"
@@ -678,12 +684,16 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0,
 
   if (rv == -1)
     {
-      int en = errno;
-
-      SCM_SYSERROR_MSG ("~A: ~S",
-			scm_list_2 (scm_strerror (scm_from_int (en)),
-				    object),
-			en);
+      if (SCM_UNBNDP (exception_on_error) || scm_is_true (exception_on_error))
+        {
+          int en = errno;
+          SCM_SYSERROR_MSG ("~A: ~S",
+                            scm_list_2 (scm_strerror (scm_from_int (en)),
+                                        object),
+                            en);
+        }
+      else
+        return SCM_BOOL_F;
     }
   return scm_stat2scm (&stat_temp);
 }
diff --git a/libguile/filesys.h b/libguile/filesys.h
index a38a5b594..cf0a6acf2 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -42,7 +42,7 @@ SCM_API SCM scm_open_fdes (SCM path, SCM flags, SCM mode);
 SCM_API SCM scm_open (SCM path, SCM flags, SCM mode);
 SCM_API SCM scm_close (SCM fd_or_port);
 SCM_API SCM scm_close_fdes (SCM fd);
-SCM_API SCM scm_stat (SCM object);
+SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
 SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_delete_file (SCM str);
diff --git a/libguile/ieee-754.h b/libguile/ieee-754.h
new file mode 100644
index 000000000..e345efaae
--- /dev/null
+++ b/libguile/ieee-754.h
@@ -0,0 +1,90 @@
+/* Copyright (C) 1992, 1995, 1996, 1999 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C 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 2.1 of the License, or (at your option) any later version.
+
+   The GNU C 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 the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+
+#ifndef SCM_IEEE_754_H
+#define SCM_IEEE_754_H 1
+
+/* Based on glibc's <ieee754.h> and modified by Ludovic Courtès to include
+   all possible IEEE-754 double-precision representations.  */
+
+
+/* IEEE 754 simple-precision format (32-bit).  */
+
+union scm_ieee754_float
+  {
+    float f;
+
+    struct
+      {
+	unsigned int negative:1;
+	unsigned int exponent:8;
+	unsigned int mantissa:23;
+      } big_endian;
+
+    struct
+      {
+      	unsigned int mantissa:23;
+	unsigned int exponent:8;
+	unsigned int negative:1;
+      } little_endian;
+  };
+
+
+
+/* IEEE 754 double-precision format (64-bit).  */
+
+union scm_ieee754_double
+  {
+    double d;
+
+    struct
+      {
+	/* Big endian.  */
+
+	unsigned int negative:1;
+	unsigned int exponent:11;
+	/* Together these comprise the mantissa.  */
+	unsigned int mantissa0:20;
+	unsigned int mantissa1:32;
+      } big_endian;
+
+    struct
+      {
+	/* Both byte order and word order are little endian.  */
+
+	/* Together these comprise the mantissa.  */
+	unsigned int mantissa1:32;
+	unsigned int mantissa0:20;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+      } little_little_endian;
+
+    struct
+      {
+	/* Byte order is little endian but word order is big endian.  Not
+	   sure this is very wide spread.  */
+	unsigned int mantissa0:20;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+	unsigned int mantissa1:32;
+      } little_big_endian;
+
+  };
+
+
+#endif /* SCM_IEEE_754_H */
diff --git a/libguile/init.c b/libguile/init.c
index dbc7f8706..c72aeff4c 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -282,7 +282,7 @@ scm_load_startup_files ()
   /* Load Ice-9.  */
   if (!scm_ice_9_already_loaded)
     {
-      scm_primitive_load_path (scm_from_locale_string ("ice-9/boot-9"));
+      scm_c_primitive_load_path ("ice-9/boot-9");
 
       /* Load the init.scm file.  */
       if (scm_is_true (init_path))
diff --git a/libguile/load.c b/libguile/load.c
index 1b5b24f35..9656359e5 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -53,6 +53,10 @@
 #include <unistd.h>
 #endif /* HAVE_UNISTD_H */
 
+#ifdef HAVE_PWD_H
+#include <pwd.h>
+#endif /* HAVE_PWD_H */
+
 #ifndef R_OK
 #define R_OK 4
 #endif
@@ -174,9 +178,15 @@ static SCM *scm_loc_load_path;
 /* List of extensions we try adding to the filenames.  */
 static SCM *scm_loc_load_extensions;
 
-/* Like %load-extensions, but for compiled files.  */
+/* Like %load-path and %load-extensions, but for compiled files. */
+static SCM *scm_loc_load_compiled_path;
 static SCM *scm_loc_load_compiled_extensions;
 
+/* Whether we should try to auto-compile. */
+static SCM *scm_loc_load_should_autocompile;
+
+/* The fallback path for autocompilation */
+static SCM *scm_loc_compile_fallback_path;
 
 SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0, 
             (SCM path, SCM tail),
@@ -209,6 +219,7 @@ scm_init_load_path ()
 {
   char *env;
   SCM path = SCM_EOL;
+  SCM cpath = SCM_EOL;
 
 #ifdef SCM_LIBRARY_DIR
   env = getenv ("GUILE_SYSTEM_PATH");
@@ -222,13 +233,49 @@ scm_init_load_path ()
     path = scm_list_3 (scm_from_locale_string (SCM_SITE_DIR),
                        scm_from_locale_string (SCM_LIBRARY_DIR),
                        scm_from_locale_string (SCM_PKGDATA_DIR));
+
+  env = getenv ("GUILE_SYSTEM_COMPILED_PATH");
+  if (env && strcmp (env, "") == 0)
+    /* like above */
+    ; 
+  else if (env)
+    cpath = scm_parse_path (scm_from_locale_string (env), cpath);
+  else
+    cpath = scm_cons (scm_from_locale_string (SCM_CCACHE_DIR), cpath);
+
 #endif /* SCM_LIBRARY_DIR */
 
+  {
+    char *home;
+
+    home = getenv ("HOME");
+#ifdef HAVE_GETPWENT
+    if (!home)
+      {
+        struct passwd *pwd;
+        pwd = getpwuid (getuid ());
+        if (pwd)
+          home = pwd->pw_dir;
+      }
+#endif /* HAVE_GETPWENT */
+    if (home)
+      { char buf[1024];
+        snprintf (buf, sizeof(buf),
+                  "%s/.guile-ccache/" SCM_EFFECTIVE_VERSION, home);
+        *scm_loc_compile_fallback_path = scm_from_locale_string (buf);
+      }
+  }
+
   env = getenv ("GUILE_LOAD_PATH");
   if (env)
     path = scm_parse_path (scm_from_locale_string (env), path);
 
+  env = getenv ("GUILE_LOAD_COMPILED_PATH");
+  if (env)
+    cpath = scm_parse_path (scm_from_locale_string (env), cpath);
+
   *scm_loc_load_path = path;
+  *scm_loc_load_compiled_path = cpath;
 }
 
 SCM scm_listofnullstr;
@@ -508,58 +555,191 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0,
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0, 
-	    (SCM filename),
+static int
+compiled_is_fresh (SCM full_filename, SCM compiled_filename)
+{
+  char *source, *compiled;
+  struct stat stat_source, stat_compiled;
+  int res;
+
+  source = scm_to_locale_string (full_filename);
+  compiled = scm_to_locale_string (compiled_filename);
+    
+  if (stat (source, &stat_source) == 0
+      && stat (compiled, &stat_compiled) == 0
+      && stat_source.st_mtime == stat_compiled.st_mtime) 
+    {
+      res = 1;
+    }
+  else
+    {
+      scm_puts (";;; note: source file ", scm_current_error_port ());
+      scm_puts (source, scm_current_error_port ());
+      scm_puts ("\n;;;       newer than compiled ", scm_current_error_port ());
+      scm_puts (compiled, scm_current_error_port ());
+      scm_puts ("\n", scm_current_error_port ());
+      res = 0;
+    }
+
+  free (source);
+  free (compiled);
+  return res;
+}
+
+static SCM
+do_try_autocompile (void *data)
+{
+  SCM source = PTR2SCM (data);
+  SCM comp_mod, compile_file;
+
+  scm_puts (";;; compiling ", scm_current_error_port ());
+  scm_display (source, scm_current_error_port ());
+  scm_newline (scm_current_error_port ());
+
+  comp_mod = scm_c_resolve_module ("system base compile");
+  compile_file = scm_module_variable
+    (comp_mod, scm_from_locale_symbol ("compile-file"));
+
+  if (scm_is_true (compile_file))
+    {
+      SCM res = scm_call_1 (scm_variable_ref (compile_file), source);
+      scm_puts (";;; compiled ", scm_current_error_port ());
+      scm_display (res, scm_current_error_port ());
+      scm_newline (scm_current_error_port ());
+      return res;
+    }
+  else
+    {
+      scm_puts (";;; it seems ", scm_current_error_port ());
+      scm_display (source, scm_current_error_port ());
+      scm_puts ("\n;;; is part of the compiler; skipping autocompilation\n",
+                scm_current_error_port ());
+      return SCM_BOOL_F;
+    }
+}
+
+static SCM
+autocompile_catch_handler (void *data, SCM tag, SCM throw_args)
+{
+  SCM source = PTR2SCM (data);
+  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 ());
+  return SCM_BOOL_F;
+}
+
+static SCM
+scm_try_autocompile (SCM source)
+{
+  static int message_shown = 0;
+  
+  if (scm_is_false (*scm_loc_load_should_autocompile))
+    return SCM_BOOL_F;
+
+  if (!message_shown)
+    {
+      scm_puts (";;; note: autocompilation is enabled, set GUILE_AUTO_COMPILE=0\n"
+                ";;;       or pass the --no-autocompile argument to disable.\n",
+                scm_current_error_port ());
+      message_shown = 1;
+    }
+
+  return scm_c_catch (SCM_BOOL_T,
+                      do_try_autocompile,
+                      SCM2PTR (source),
+                      autocompile_catch_handler,
+                      SCM2PTR (source),
+                      NULL, NULL);
+}
+
+SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 1, 0, 
+	    (SCM filename, SCM exception_on_not_found),
 	    "Search @var{%load-path} for the file named @var{filename} and\n"
 	    "load it into the top-level environment.  If @var{filename} is a\n"
 	    "relative pathname and is not found in the list of search paths,\n"
-	    "an error is signalled.")
+	    "an error is signalled, unless the optional argument\n"
+            "@var{exception_on_not_found} is @code{#f}, in which case\n"
+            "@code{#f} is returned instead.")
 #define FUNC_NAME s_scm_primitive_load_path
 {
   SCM full_filename, compiled_filename;
+  int compiled_is_fallback = 0;
+
+  if (SCM_UNBNDP (exception_on_not_found))
+    exception_on_not_found = SCM_BOOL_T;
 
   full_filename = scm_sys_search_load_path (filename);
-  compiled_filename = scm_search_path (*scm_loc_load_path,
+  compiled_filename = scm_search_path (*scm_loc_load_compiled_path,
                                        filename,
                                        *scm_loc_load_compiled_extensions,
                                        SCM_BOOL_T);
-
+  
+  if (scm_is_false (compiled_filename)
+      && scm_is_true (full_filename)
+      && scm_is_true (*scm_loc_compile_fallback_path)
+      && scm_is_pair (*scm_loc_load_compiled_extensions)
+      && scm_is_string (scm_car (*scm_loc_load_compiled_extensions)))
+    {
+      SCM fallback = scm_string_append
+        (scm_list_3 (*scm_loc_compile_fallback_path,
+                     full_filename,
+                     scm_car (*scm_loc_load_compiled_extensions)));
+      if (scm_is_true (scm_stat (fallback, SCM_BOOL_F)))
+        {
+          compiled_filename = fallback;
+          compiled_is_fallback = 1;
+        }
+    }
+  
   if (scm_is_false (full_filename) && scm_is_false (compiled_filename))
-    SCM_MISC_ERROR ("Unable to find file ~S in load path",
-		    scm_list_1 (filename));
-
-  if (scm_is_false (compiled_filename))
-    return scm_primitive_load (full_filename);
+    {
+      if (scm_is_true (exception_on_not_found))
+        SCM_MISC_ERROR ("Unable to find file ~S in load path",
+                        scm_list_1 (filename));
+      else
+        return SCM_BOOL_F;
+    }
 
-  if (scm_is_false (full_filename))
+  if (scm_is_false (full_filename)
+      || (scm_is_true (compiled_filename)
+          && compiled_is_fresh (full_filename, compiled_filename)))
     return scm_load_compiled_with_vm (compiled_filename);
 
+  /* Perhaps there was the installed .go that was stale, but our fallback is
+     fresh. Let's try that. Duplicating code, but perhaps that's OK. */
+
+  if (!compiled_is_fallback
+      && scm_is_true (*scm_loc_compile_fallback_path)
+      && scm_is_pair (*scm_loc_load_compiled_extensions)
+      && scm_is_string (scm_car (*scm_loc_load_compiled_extensions)))
+    {
+      SCM fallback = scm_string_append
+        (scm_list_3 (*scm_loc_compile_fallback_path,
+                     full_filename,
+                     scm_car (*scm_loc_load_compiled_extensions)));
+      if (scm_is_true (scm_stat (fallback, SCM_BOOL_F))
+          && compiled_is_fresh (full_filename, fallback))
+        {
+          scm_puts (";;; found fresh local cache at ", scm_current_error_port ());
+          scm_display (fallback, scm_current_error_port ());
+          scm_newline (scm_current_error_port ());
+          return scm_load_compiled_with_vm (compiled_filename);
+        }
+    }
+
+  /* Otherwise, we bottom out here. */
   {
-    char *source, *compiled;
-    struct stat stat_source, stat_compiled;
+    SCM freshly_compiled = scm_try_autocompile (full_filename);
 
-    source = scm_to_locale_string (full_filename);
-    compiled = scm_to_locale_string (compiled_filename);
-    
-    if (stat (source, &stat_source) == 0
-        && stat (compiled, &stat_compiled) == 0
-        && stat_source.st_mtime <= stat_compiled.st_mtime) 
-      {
-        free (source);
-        free (compiled);
-        return scm_load_compiled_with_vm (compiled_filename);
-      }
+    if (scm_is_true (freshly_compiled))
+      return scm_load_compiled_with_vm (freshly_compiled);
     else
-      {
-        scm_puts (";;; note: source file ", scm_current_error_port ());
-        scm_puts (source, scm_current_error_port ());
-        scm_puts (" newer than compiled ", scm_current_error_port ());
-        scm_puts (compiled, scm_current_error_port ());
-        scm_puts ("\n", scm_current_error_port ());
-        free (source);
-        free (compiled);
-        return scm_primitive_load (full_filename);
-      }
+      return scm_primitive_load (full_filename);
   }
 }
 #undef FUNC_NAME
@@ -567,7 +747,8 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
 SCM
 scm_c_primitive_load_path (const char *filename)
 {
-  return scm_primitive_load_path (scm_from_locale_string (filename));
+  return scm_primitive_load_path (scm_from_locale_string (filename),
+                                  SCM_BOOL_T);
 }
 
 
@@ -600,11 +781,19 @@ scm_init_load ()
     = SCM_VARIABLE_LOC (scm_c_define ("%load-extensions",
 				      scm_list_2 (scm_from_locale_string (".scm"),
 						  scm_nullstr)));
+  scm_loc_load_compiled_path
+    = SCM_VARIABLE_LOC (scm_c_define ("%load-compiled-path", SCM_EOL));
   scm_loc_load_compiled_extensions
     = SCM_VARIABLE_LOC (scm_c_define ("%load-compiled-extensions",
 				      scm_list_1 (scm_from_locale_string (".go"))));
   scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook", SCM_BOOL_F));
 
+  scm_loc_compile_fallback_path
+    = SCM_VARIABLE_LOC (scm_c_define ("%compile-fallback-path", SCM_BOOL_F));
+
+  scm_loc_load_should_autocompile
+    = SCM_VARIABLE_LOC (scm_c_define ("%load-should-autocompile", SCM_BOOL_F));
+
   the_reader = scm_make_fluid ();
   the_reader_fluid_num = SCM_FLUID_NUM (the_reader);
   SCM_FAST_FLUID_SET_X (the_reader_fluid_num, SCM_BOOL_F);
diff --git a/libguile/load.h b/libguile/load.h
index 87f336e1e..021987329 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -33,7 +33,7 @@ SCM_API SCM scm_sys_library_dir (void);
 SCM_API SCM scm_sys_site_dir (void);
 SCM_API SCM scm_search_path (SCM path, SCM filename, SCM exts, SCM require_exts);
 SCM_API SCM scm_sys_search_load_path (SCM filename);
-SCM_API SCM scm_primitive_load_path (SCM filename);
+SCM_API SCM scm_primitive_load_path (SCM filename, SCM exception_on_not_found);
 SCM_API SCM scm_c_primitive_load_path (const char *filename);
 SCM_INTERNAL void scm_init_load_path (void);
 SCM_INTERNAL void scm_init_load (void);
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
new file mode 100644
index 000000000..a07636fce
--- /dev/null
+++ b/libguile/r6rs-ports.c
@@ -0,0 +1,1118 @@
+/* Copyright (C) 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#include <string.h>
+#include <stdio.h>
+#include <assert.h>
+
+#include "libguile/_scm.h"
+#include "libguile/bytevectors.h"
+#include "libguile/chars.h"
+#include "libguile/eval.h"
+#include "libguile/r6rs-ports.h"
+#include "libguile/strings.h"
+#include "libguile/validate.h"
+#include "libguile/values.h"
+#include "libguile/vectors.h"
+
+
+
+/* Unimplemented features.  */
+
+
+/* Transoders are currently not implemented since Guile 1.8 is not
+   Unicode-capable.  Thus, most of the code here assumes the use of the
+   binary transcoder.  */
+static inline void
+transcoders_not_implemented (void)
+{
+  fprintf (stderr, "%s: warning: transcoders not implemented\n",
+	   PACKAGE_NAME);
+}
+
+
+/* End-of-file object.  */
+
+SCM_DEFINE (scm_eof_object, "eof-object", 0, 0, 0,
+	    (void),
+	    "Return the end-of-file object.")
+#define FUNC_NAME s_scm_eof_object
+{
+  return (SCM_EOF_VAL);
+}
+#undef FUNC_NAME
+
+
+/* Input ports.  */
+
+#ifndef MIN
+# define MIN(a,b) ((a) < (b) ? (a) : (b))
+#endif
+
+/* Bytevector input ports or "bip" for short.  */
+static scm_t_bits bytevector_input_port_type = 0;
+
+static inline SCM
+make_bip (SCM bv)
+{
+  SCM port;
+  char *c_bv;
+  unsigned c_len;
+  scm_t_port *c_port;
+  const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
+
+  port = scm_new_port_table_entry (bytevector_input_port_type);
+
+  /* Prevent BV from being GC'd.  */
+  SCM_SETSTREAM (port, SCM_UNPACK (bv));
+
+  /* Have the port directly access the bytevector.  */
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
+  c_port->read_end = (unsigned char *) c_bv + c_len;
+  c_port->read_buf_size = c_len;
+
+  /* Mark PORT as open, readable and unbuffered (hmm, how elegant...).  */
+  SCM_SET_CELL_TYPE (port, bytevector_input_port_type | mode_bits);
+
+  return port;
+}
+
+static SCM
+bip_mark (SCM port)
+{
+  /* Mark the underlying bytevector.  */
+  return (SCM_PACK (SCM_STREAM (port)));
+}
+
+static int
+bip_fill_input (SCM port)
+{
+  int result;
+  scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+
+  if (c_port->read_pos >= c_port->read_end)
+    result = EOF;
+  else
+    result = (int) *c_port->read_pos;
+
+  return result;
+}
+
+static off_t
+bip_seek (SCM port, off_t offset, int whence)
+#define FUNC_NAME "bip_seek"
+{
+  off_t c_result = 0;
+  scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+
+  switch (whence)
+    {
+    case SEEK_CUR:
+      offset += c_port->read_pos - c_port->read_buf;
+      /* Fall through.  */
+
+    case SEEK_SET:
+      if (c_port->read_buf + offset < c_port->read_end)
+	{
+	  c_port->read_pos = c_port->read_buf + offset;
+	  c_result = offset;
+	}
+      else
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      break;
+
+    case SEEK_END:
+      if (c_port->read_end - offset >= c_port->read_buf)
+	{
+	  c_port->read_pos = c_port->read_end - offset;
+	  c_result = c_port->read_pos - c_port->read_buf;
+	}
+      else
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      break;
+
+    default:
+      scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+			      "invalid `seek' parameter");
+    }
+
+  return c_result;
+}
+#undef FUNC_NAME
+
+
+/* Instantiate the bytevector input port type.  */
+static inline void
+initialize_bytevector_input_ports (void)
+{
+  bytevector_input_port_type =
+    scm_make_port_type ("r6rs-bytevector-input-port", bip_fill_input,
+			NULL);
+
+  scm_set_port_mark (bytevector_input_port_type, bip_mark);
+  scm_set_port_seek (bytevector_input_port_type, bip_seek);
+}
+
+
+SCM_DEFINE (scm_open_bytevector_input_port,
+	    "open-bytevector-input-port", 1, 1, 0,
+	    (SCM bv, SCM transcoder),
+	    "Return an input port whose contents are drawn from "
+	    "bytevector @var{bv}.")
+#define FUNC_NAME s_scm_open_bytevector_input_port
+{
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+  if (!SCM_UNBNDP (transcoder) && !scm_is_false (transcoder))
+    transcoders_not_implemented ();
+
+  return (make_bip (bv));
+}
+#undef FUNC_NAME
+
+
+/* Custom binary ports.  The following routines are shared by input and
+   output custom binary ports.  */
+
+#define SCM_CBP_GET_POSITION_PROC(_port)			\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 1)
+#define SCM_CBP_SET_POSITION_PROC(_port)			\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 2)
+#define SCM_CBP_CLOSE_PROC(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 3)
+
+static SCM
+cbp_mark (SCM port)
+{
+  /* Mark the underlying method and object vector.  */
+  return (SCM_PACK (SCM_STREAM (port)));
+}
+
+static off_t
+cbp_seek (SCM port, off_t offset, int whence)
+#define FUNC_NAME "cbp_seek"
+{
+  SCM result;
+  off_t c_result = 0;
+
+  switch (whence)
+    {
+    case SEEK_CUR:
+      {
+	SCM get_position_proc;
+
+	get_position_proc = SCM_CBP_GET_POSITION_PROC (port);
+	if (SCM_LIKELY (scm_is_true (get_position_proc)))
+	  result = scm_call_0 (get_position_proc);
+	else
+	  scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+				  "R6RS custom binary port does not "
+				  "support `port-position'");
+
+	offset += scm_to_int (result);
+	/* Fall through.  */
+      }
+
+    case SEEK_SET:
+      {
+	SCM set_position_proc;
+
+	set_position_proc = SCM_CBP_SET_POSITION_PROC (port);
+	if (SCM_LIKELY (scm_is_true (set_position_proc)))
+	  result = scm_call_1 (set_position_proc, scm_from_int (offset));
+	else
+	  scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+				  "R6RS custom binary port does not "
+				  "support `set-port-position!'");
+
+	/* Assuming setting the position succeeded.  */
+	c_result = offset;
+	break;
+      }
+
+    default:
+      /* `SEEK_END' cannot be supported.  */
+      scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+			      "R6RS custom binary ports do not "
+			      "support `SEEK_END'");
+    }
+
+  return c_result;
+}
+#undef FUNC_NAME
+
+static int
+cbp_close (SCM port)
+{
+  SCM close_proc;
+
+  close_proc = SCM_CBP_CLOSE_PROC (port);
+  if (scm_is_true (close_proc))
+    /* Invoke the `close' thunk.  */
+    scm_call_0 (close_proc);
+
+  return 1;
+}
+
+
+/* Custom binary input port ("cbip" for short).  */
+
+static scm_t_bits custom_binary_input_port_type = 0;
+
+/* Size of the buffer embedded in custom binary input ports.  */
+#define CBIP_BUFFER_SIZE  4096
+
+/* Return the bytevector associated with PORT.  */
+#define SCM_CBIP_BYTEVECTOR(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 4)
+
+/* Return the various procedures of PORT.  */
+#define SCM_CBIP_READ_PROC(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
+
+
+static inline SCM
+make_cbip (SCM read_proc, SCM get_position_proc,
+	   SCM set_position_proc, SCM close_proc)
+{
+  SCM port, bv, method_vector;
+  char *c_bv;
+  unsigned c_len;
+  scm_t_port *c_port;
+  const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
+
+  /* Use a bytevector as the underlying buffer.  */
+  c_len = CBIP_BUFFER_SIZE;
+  bv = scm_c_make_bytevector (c_len);
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  /* Store the various methods and bytevector in a vector.  */
+  method_vector = scm_c_make_vector (5, SCM_BOOL_F);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 4, bv);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 0, read_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 1, get_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc);
+
+  port = scm_new_port_table_entry (custom_binary_input_port_type);
+
+  /* Attach it the method vector.  */
+  SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
+
+  /* Have the port directly access the buffer (bytevector).  */
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
+  c_port->read_end = (unsigned char *) c_bv;
+  c_port->read_buf_size = c_len;
+
+  /* Mark PORT as open, readable and unbuffered (hmm, how elegant...).  */
+  SCM_SET_CELL_TYPE (port, custom_binary_input_port_type | mode_bits);
+
+  return port;
+}
+
+static int
+cbip_fill_input (SCM port)
+#define FUNC_NAME "cbip_fill_input"
+{
+  int result;
+  scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+
+ again:
+  if (c_port->read_pos >= c_port->read_end)
+    {
+      /* Invoke the user's `read!' procedure.  */
+      unsigned c_octets;
+      SCM bv, read_proc, octets;
+
+      /* Use the bytevector associated with PORT as the buffer passed to the
+	 `read!' procedure, thereby avoiding additional allocations.  */
+      bv = SCM_CBIP_BYTEVECTOR (port);
+      read_proc = SCM_CBIP_READ_PROC (port);
+
+      /* The assumption here is that C_PORT's internal buffer wasn't changed
+	 behind our back.  */
+      assert (c_port->read_buf ==
+	      (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
+      assert ((unsigned) c_port->read_buf_size
+	      == SCM_BYTEVECTOR_LENGTH (bv));
+
+      octets = scm_call_3 (read_proc, bv, SCM_INUM0,
+			   SCM_I_MAKINUM (CBIP_BUFFER_SIZE));
+      c_octets = scm_to_uint (octets);
+
+      c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+      c_port->read_end = (unsigned char *) c_port->read_pos + c_octets;
+
+      if (c_octets > 0)
+	goto again;
+      else
+	result = EOF;
+    }
+  else
+    result = (int) *c_port->read_pos;
+
+  return result;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_make_custom_binary_input_port,
+	    "make-custom-binary-input-port", 5, 0, 0,
+	    (SCM id, SCM read_proc, SCM get_position_proc,
+	     SCM set_position_proc, SCM close_proc),
+	    "Return a new custom binary input port whose input is drained "
+	    "by invoking @var{read_proc} and passing it a bytevector, an "
+	    "index where octets should be written, and an octet count.")
+#define FUNC_NAME s_scm_make_custom_binary_input_port
+{
+  SCM_VALIDATE_STRING (1, id);
+  SCM_VALIDATE_PROC (2, read_proc);
+
+  if (!scm_is_false (get_position_proc))
+    SCM_VALIDATE_PROC (3, get_position_proc);
+
+  if (!scm_is_false (set_position_proc))
+    SCM_VALIDATE_PROC (4, set_position_proc);
+
+  if (!scm_is_false (close_proc))
+    SCM_VALIDATE_PROC (5, close_proc);
+
+  return (make_cbip (read_proc, get_position_proc, set_position_proc,
+		     close_proc));
+}
+#undef FUNC_NAME
+
+
+/* Instantiate the custom binary input port type.  */
+static inline void
+initialize_custom_binary_input_ports (void)
+{
+  custom_binary_input_port_type =
+    scm_make_port_type ("r6rs-custom-binary-input-port",
+			cbip_fill_input, NULL);
+
+  scm_set_port_mark (custom_binary_input_port_type, cbp_mark);
+  scm_set_port_seek (custom_binary_input_port_type, cbp_seek);
+  scm_set_port_close (custom_binary_input_port_type, cbp_close);
+}
+
+
+
+/* Binary input.  */
+
+/* We currently don't support specific binary input ports.  */
+#define SCM_VALIDATE_BINARY_INPUT_PORT SCM_VALIDATE_OPINPORT
+
+SCM_DEFINE (scm_get_u8, "get-u8", 1, 0, 0,
+	    (SCM port),
+	    "Read an octet from @var{port}, a binary input port, "
+	    "blocking as necessary.")
+#define FUNC_NAME s_scm_get_u8
+{
+  SCM result;
+  int c_result;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  c_result = scm_getc (port);
+  if (c_result == EOF)
+    result = SCM_EOF_VAL;
+  else
+    result = SCM_I_MAKINUM ((unsigned char) c_result);
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_lookahead_u8, "lookahead-u8", 1, 0, 0,
+	    (SCM port),
+	    "Like @code{get-u8} but does not update @var{port} to "
+	    "point past the octet.")
+#define FUNC_NAME s_scm_lookahead_u8
+{
+  SCM result;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  result = scm_peek_char (port);
+  if (SCM_CHARP (result))
+    result = SCM_I_MAKINUM ((signed char) SCM_CHAR (result));
+  else
+    result = SCM_EOF_VAL;
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0, 0,
+	    (SCM port, SCM count),
+	    "Read @var{count} octets from @var{port}, blocking as "
+	    "necessary and return a bytevector containing the octets "
+	    "read.  If fewer bytes are available, a bytevector smaller "
+	    "than @var{count} is returned.")
+#define FUNC_NAME s_scm_get_bytevector_n
+{
+  SCM result;
+  char *c_bv;
+  unsigned c_count;
+  size_t c_read;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+  c_count = scm_to_uint (count);
+
+  result = scm_c_make_bytevector (c_count);
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (result);
+
+  if (SCM_LIKELY (c_count > 0))
+    /* XXX: `scm_c_read ()' does not update the port position.  */
+    c_read = scm_c_read (port, c_bv, c_count);
+  else
+    /* Don't invoke `scm_c_read ()' since it may block.  */
+    c_read = 0;
+
+  if ((c_read == 0) && (c_count > 0))
+    {
+      if (SCM_EOF_OBJECT_P (scm_peek_char (port)))
+	result = SCM_EOF_VAL;
+      else
+	result = scm_null_bytevector;
+    }
+  else
+    {
+      if (c_read < c_count)
+	result = scm_c_shrink_bytevector (result, c_read);
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4, 0, 0,
+	    (SCM port, SCM bv, SCM start, SCM count),
+	    "Read @var{count} bytes from @var{port} and store them "
+	    "in @var{bv} starting at index @var{start}.  Return either "
+	    "the number of bytes actually read or the end-of-file "
+	    "object.")
+#define FUNC_NAME s_scm_get_bytevector_n_x
+{
+  SCM result;
+  char *c_bv;
+  unsigned c_start, c_count, c_len;
+  size_t c_read;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+  SCM_VALIDATE_BYTEVECTOR (2, bv);
+  c_start = scm_to_uint (start);
+  c_count = scm_to_uint (count);
+
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+
+  if (SCM_UNLIKELY (c_start + c_count > c_len))
+    scm_out_of_range (FUNC_NAME, count);
+
+  if (SCM_LIKELY (c_count > 0))
+    c_read = scm_c_read (port, c_bv + c_start, c_count);
+  else
+    /* Don't invoke `scm_c_read ()' since it may block.  */
+    c_read = 0;
+
+  if ((c_read == 0) && (c_count > 0))
+    {
+      if (SCM_EOF_OBJECT_P (scm_peek_char (port)))
+	result = SCM_EOF_VAL;
+      else
+	result = SCM_I_MAKINUM (0);
+    }
+  else
+    result = scm_from_size_t (c_read);
+
+  return result;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
+	    (SCM port),
+	    "Read from @var{port}, blocking as necessary, until data "
+	    "are available or and end-of-file is reached.  Return either "
+	    "a new bytevector containing the data read or the "
+	    "end-of-file object.")
+#define FUNC_NAME s_scm_get_bytevector_some
+{
+  /* Read at least one byte, unless the end-of-file is already reached, and
+     read while characters are available (buffered).  */
+
+  SCM result;
+  char *c_bv;
+  unsigned c_len;
+  size_t c_total;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  c_len = 4096;
+  c_bv = (char *) scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR);
+  c_total = 0;
+
+  do
+    {
+      int c_chr;
+
+      if (c_total + 1 > c_len)
+	{
+	  /* Grow the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_len * 2,
+					  SCM_GC_BYTEVECTOR);
+	  c_len *= 2;
+	}
+
+      /* We can't use `scm_c_read ()' since it blocks.  */
+      c_chr = scm_getc (port);
+      if (c_chr != EOF)
+	{
+	  c_bv[c_total] = (char) c_chr;
+	  c_total++;
+	}
+    }
+  while ((scm_is_true (scm_char_ready_p (port)))
+	 && (!SCM_EOF_OBJECT_P (scm_peek_char (port))));
+
+  if (c_total == 0)
+    {
+      result = SCM_EOF_VAL;
+      scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
+    }
+  else
+    {
+      if (c_len > c_total)
+	{
+	  /* Shrink the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_total,
+					  SCM_GC_BYTEVECTOR);
+	  c_len = (unsigned) c_total;
+	}
+
+      result = scm_c_take_bytevector ((signed char *) c_bv, c_len);
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0,
+	    (SCM port),
+	    "Read from @var{port}, blocking as necessary, until "
+	    "the end-of-file is reached.  Return either "
+	    "a new bytevector containing the data read or the "
+	    "end-of-file object (if no data were available).")
+#define FUNC_NAME s_scm_get_bytevector_all
+{
+  SCM result;
+  char *c_bv;
+  unsigned c_len, c_count;
+  size_t c_read, c_total;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  c_len = c_count = 4096;
+  c_bv = (char *) scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR);
+  c_total = c_read = 0;
+
+  do
+    {
+      if (c_total + c_read > c_len)
+	{
+	  /* Grow the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_len * 2,
+					  SCM_GC_BYTEVECTOR);
+	  c_count = c_len;
+	  c_len *= 2;
+	}
+
+      /* `scm_c_read ()' blocks until C_COUNT bytes are available or EOF is
+	 reached.  */
+      c_read = scm_c_read (port, c_bv + c_total, c_count);
+      c_total += c_read, c_count -= c_read;
+    }
+  while (!SCM_EOF_OBJECT_P (scm_peek_char (port)));
+
+  if (c_total == 0)
+    {
+      result = SCM_EOF_VAL;
+      scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
+    }
+  else
+    {
+      if (c_len > c_total)
+	{
+	  /* Shrink the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_total,
+					  SCM_GC_BYTEVECTOR);
+	  c_len = (unsigned) c_total;
+	}
+
+      result = scm_c_take_bytevector ((signed char *) c_bv, c_len);
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+
+
+/* Binary output.  */
+
+/* We currently don't support specific binary input ports.  */
+#define SCM_VALIDATE_BINARY_OUTPUT_PORT SCM_VALIDATE_OPOUTPORT
+
+
+SCM_DEFINE (scm_put_u8, "put-u8", 2, 0, 0,
+	    (SCM port, SCM octet),
+	    "Write @var{octet} to binary port @var{port}.")
+#define FUNC_NAME s_scm_put_u8
+{
+  scm_t_uint8 c_octet;
+
+  SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
+  c_octet = scm_to_uint8 (octet);
+
+  scm_putc ((char) c_octet, port);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_put_bytevector, "put-bytevector", 2, 2, 0,
+	    (SCM port, SCM bv, SCM start, SCM count),
+	    "Write the contents of @var{bv} to @var{port}, optionally "
+	    "starting at index @var{start} and limiting to @var{count} "
+	    "octets.")
+#define FUNC_NAME s_scm_put_bytevector
+{
+  char *c_bv;
+  unsigned c_start, c_count, c_len;
+
+  SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
+  SCM_VALIDATE_BYTEVECTOR (2, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  if (start != SCM_UNDEFINED)
+    {
+      c_start = scm_to_uint (start);
+
+      if (count != SCM_UNDEFINED)
+	{
+	  c_count = scm_to_uint (count);
+	  if (SCM_UNLIKELY (c_start + c_count > c_len))
+	    scm_out_of_range (FUNC_NAME, count);
+	}
+      else
+	{
+	  if (SCM_UNLIKELY (c_start >= c_len))
+	    scm_out_of_range (FUNC_NAME, start);
+	  else
+	    c_count = c_len - c_start;
+	}
+    }
+  else
+    c_start = 0, c_count = c_len;
+
+  scm_c_write (port, c_bv + c_start, c_count);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+
+/* Bytevector output port ("bop" for short).  */
+
+/* Implementation of "bops".
+
+   Each bop has an internal buffer, of type `scm_t_bop_buffer', attached to
+   it.  The procedure returned along with the output port is actually an
+   applicable SMOB.  The SMOB holds a reference to the port.  When applied,
+   the SMOB swallows the port's internal buffer, turning it into a
+   bytevector, and resets it.
+
+   XXX: Access to a bop's internal buffer is not thread-safe.  */
+
+static scm_t_bits bytevector_output_port_type = 0;
+
+SCM_SMOB (bytevector_output_port_procedure,
+	  "r6rs-bytevector-output-port-procedure",
+	  0);
+
+#define SCM_GC_BOP "r6rs-bytevector-output-port"
+#define SCM_BOP_BUFFER_INITIAL_SIZE 4096
+
+/* Representation of a bop's internal buffer.  */
+typedef struct
+{
+  size_t total_len;
+  size_t len;
+  size_t pos;
+  char  *buffer;
+} scm_t_bop_buffer;
+
+
+/* Accessing a bop's buffer.  */
+#define SCM_BOP_BUFFER(_port)		\
+  ((scm_t_bop_buffer *) SCM_STREAM (_port))
+#define SCM_SET_BOP_BUFFER(_port, _buf)		\
+  (SCM_SETSTREAM ((_port), (scm_t_bits) (_buf)))
+
+
+static inline void
+bop_buffer_init (scm_t_bop_buffer *buf)
+{
+  buf->total_len = buf->len = buf->pos = 0;
+  buf->buffer = NULL;
+}
+
+static inline void
+bop_buffer_grow (scm_t_bop_buffer *buf, size_t min_size)
+{
+  char *new_buf;
+  size_t new_size;
+
+  for (new_size = buf->total_len
+	 ? buf->total_len : SCM_BOP_BUFFER_INITIAL_SIZE;
+       new_size < min_size;
+       new_size *= 2);
+
+  if (buf->buffer)
+    new_buf = scm_gc_realloc ((void *) buf->buffer, buf->total_len,
+			      new_size, SCM_GC_BOP);
+  else
+    new_buf = scm_gc_malloc (new_size, SCM_GC_BOP);
+
+  buf->buffer = new_buf;
+  buf->total_len = new_size;
+}
+
+static inline SCM
+make_bop (void)
+{
+  SCM port, bop_proc;
+  scm_t_port *c_port;
+  scm_t_bop_buffer *buf;
+  const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
+
+  port = scm_new_port_table_entry (bytevector_output_port_type);
+
+  buf = (scm_t_bop_buffer *) scm_gc_malloc (sizeof (* buf), SCM_GC_BOP);
+  bop_buffer_init (buf);
+
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
+  c_port->write_buf_size = 0;
+
+  SCM_SET_BOP_BUFFER (port, buf);
+
+  /* Mark PORT as open and writable.  */
+  SCM_SET_CELL_TYPE (port, bytevector_output_port_type | mode_bits);
+
+  /* Make the bop procedure.  */
+  SCM_NEWSMOB (bop_proc, bytevector_output_port_procedure,
+	       SCM_PACK (port));
+
+  return (scm_values (scm_list_2 (port, bop_proc)));
+}
+
+static size_t
+bop_free (SCM port)
+{
+  /* The port itself is necessarily freed _after_ the bop proc, since the bop
+     proc holds a reference to it.  Thus we can safely free the internal
+     buffer when the bop becomes unreferenced.  */
+  scm_t_bop_buffer *buf;
+
+  buf = SCM_BOP_BUFFER (port);
+  if (buf->buffer)
+    scm_gc_free (buf->buffer, buf->total_len, SCM_GC_BOP);
+
+  scm_gc_free (buf, sizeof (* buf), SCM_GC_BOP);
+
+  return 0;
+}
+
+/* Write SIZE octets from DATA to PORT.  */
+static void
+bop_write (SCM port, const void *data, size_t size)
+{
+  scm_t_bop_buffer *buf;
+
+  buf = SCM_BOP_BUFFER (port);
+
+  if (buf->pos + size > buf->total_len)
+    bop_buffer_grow (buf, buf->pos + size);
+
+  memcpy (buf->buffer + buf->pos, data, size);
+  buf->pos += size;
+  buf->len = (buf->len > buf->pos) ? buf->len : buf->pos;
+}
+
+static off_t
+bop_seek (SCM port, off_t offset, int whence)
+#define FUNC_NAME "bop_seek"
+{
+  scm_t_bop_buffer *buf;
+
+  buf = SCM_BOP_BUFFER (port);
+  switch (whence)
+    {
+    case SEEK_CUR:
+      offset += (off_t) buf->pos;
+      /* Fall through.  */
+
+    case SEEK_SET:
+      if (offset < 0 || (unsigned) offset > buf->len)
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      else
+	buf->pos = offset;
+      break;
+
+    case SEEK_END:
+      if (offset < 0 || (unsigned) offset >= buf->len)
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      else
+	buf->pos = buf->len - (offset + 1);
+      break;
+
+    default:
+      scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+			      "invalid `seek' parameter");
+    }
+
+  return buf->pos;
+}
+#undef FUNC_NAME
+
+/* Fetch data from a bop.  */
+SCM_SMOB_APPLY (bytevector_output_port_procedure,
+		bop_proc_apply, 0, 0, 0, (SCM bop_proc))
+{
+  SCM port, bv;
+  scm_t_bop_buffer *buf, result_buf;
+
+  port = SCM_PACK (SCM_SMOB_DATA (bop_proc));
+  buf = SCM_BOP_BUFFER (port);
+
+  result_buf = *buf;
+  bop_buffer_init (buf);
+
+  if (result_buf.len == 0)
+    bv = scm_c_take_bytevector (NULL, 0);
+  else
+    {
+      if (result_buf.total_len > result_buf.len)
+	/* Shrink the buffer.  */
+	result_buf.buffer = scm_gc_realloc ((void *) result_buf.buffer,
+					    result_buf.total_len,
+					    result_buf.len,
+					    SCM_GC_BOP);
+
+      bv = scm_c_take_bytevector ((signed char *) result_buf.buffer,
+				       result_buf.len);
+    }
+
+  return bv;
+}
+
+SCM_SMOB_MARK (bytevector_output_port_procedure, bop_proc_mark,
+	       bop_proc)
+{
+  /* Mark the port associated with BOP_PROC.  */
+  return (SCM_PACK (SCM_SMOB_DATA (bop_proc)));
+}
+
+
+SCM_DEFINE (scm_open_bytevector_output_port,
+	    "open-bytevector-output-port", 0, 1, 0,
+	    (SCM transcoder),
+	    "Return two values: an output port and a procedure.  The latter "
+	    "should be called with zero arguments to obtain a bytevector "
+	    "containing the data accumulated by the port.")
+#define FUNC_NAME s_scm_open_bytevector_output_port
+{
+  if (!SCM_UNBNDP (transcoder) && !scm_is_false (transcoder))
+    transcoders_not_implemented ();
+
+  return (make_bop ());
+}
+#undef FUNC_NAME
+
+static inline void
+initialize_bytevector_output_ports (void)
+{
+  bytevector_output_port_type =
+    scm_make_port_type ("r6rs-bytevector-output-port",
+			NULL, bop_write);
+
+  scm_set_port_seek (bytevector_output_port_type, bop_seek);
+  scm_set_port_free (bytevector_output_port_type, bop_free);
+}
+
+
+/* Custom binary output port ("cbop" for short).  */
+
+static scm_t_bits custom_binary_output_port_type;
+
+/* Return the various procedures of PORT.  */
+#define SCM_CBOP_WRITE_PROC(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
+
+
+static inline SCM
+make_cbop (SCM write_proc, SCM get_position_proc,
+	   SCM set_position_proc, SCM close_proc)
+{
+  SCM port, method_vector;
+  scm_t_port *c_port;
+  const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
+
+  /* Store the various methods and bytevector in a vector.  */
+  method_vector = scm_c_make_vector (4, SCM_BOOL_F);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 0, write_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 1, get_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc);
+
+  port = scm_new_port_table_entry (custom_binary_output_port_type);
+
+  /* Attach it the method vector.  */
+  SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
+
+  /* Have the port directly access the buffer (bytevector).  */
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
+  c_port->write_buf_size = c_port->read_buf_size = 0;
+
+  /* Mark PORT as open, writable and unbuffered.  */
+  SCM_SET_CELL_TYPE (port, custom_binary_output_port_type | mode_bits);
+
+  return port;
+}
+
+/* Write SIZE octets from DATA to PORT.  */
+static void
+cbop_write (SCM port, const void *data, size_t size)
+#define FUNC_NAME "cbop_write"
+{
+  long int c_result;
+  size_t c_written;
+  SCM bv, write_proc, result;
+
+  /* XXX: Allocating a new bytevector at each `write' call is inefficient,
+     but necessary since (1) we don't control the lifetime of the buffer
+     pointed to by DATA, and (2) the `write!' procedure could capture the
+     bytevector it is passed.  */
+  bv = scm_c_make_bytevector (size);
+  memcpy (SCM_BYTEVECTOR_CONTENTS (bv), data, size);
+
+  write_proc = SCM_CBOP_WRITE_PROC (port);
+
+  /* Since the `write' procedure of Guile's ports has type `void', it must
+     try hard to write exactly SIZE bytes, regardless of how many bytes the
+     sink can handle.  */
+  for (c_written = 0;
+       c_written < size;
+       c_written += c_result)
+    {
+      result = scm_call_3 (write_proc, bv,
+			   scm_from_size_t (c_written),
+			   scm_from_size_t (size - c_written));
+
+      c_result = scm_to_long (result);
+      if (SCM_UNLIKELY (c_result < 0
+			|| (size_t) c_result > (size - c_written)))
+	scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
+				"R6RS custom binary output port `write!' "
+				"returned a incorrect integer");
+    }
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_make_custom_binary_output_port,
+	    "make-custom-binary-output-port", 5, 0, 0,
+	    (SCM id, SCM write_proc, SCM get_position_proc,
+	     SCM set_position_proc, SCM close_proc),
+	    "Return a new custom binary output port whose output is drained "
+	    "by invoking @var{write_proc} and passing it a bytevector, an "
+	    "index where octets should be written, and an octet count.")
+#define FUNC_NAME s_scm_make_custom_binary_output_port
+{
+  SCM_VALIDATE_STRING (1, id);
+  SCM_VALIDATE_PROC (2, write_proc);
+
+  if (!scm_is_false (get_position_proc))
+    SCM_VALIDATE_PROC (3, get_position_proc);
+
+  if (!scm_is_false (set_position_proc))
+    SCM_VALIDATE_PROC (4, set_position_proc);
+
+  if (!scm_is_false (close_proc))
+    SCM_VALIDATE_PROC (5, close_proc);
+
+  return (make_cbop (write_proc, get_position_proc, set_position_proc,
+		     close_proc));
+}
+#undef FUNC_NAME
+
+
+/* Instantiate the custom binary output port type.  */
+static inline void
+initialize_custom_binary_output_ports (void)
+{
+  custom_binary_output_port_type =
+    scm_make_port_type ("r6rs-custom-binary-output-port",
+			NULL, cbop_write);
+
+  scm_set_port_mark (custom_binary_output_port_type, cbp_mark);
+  scm_set_port_seek (custom_binary_output_port_type, cbp_seek);
+  scm_set_port_close (custom_binary_output_port_type, cbp_close);
+}
+
+
+/* Initialization.  */
+
+void
+scm_init_r6rs_ports (void)
+{
+#include "r6rs-ports.x"
+
+  initialize_bytevector_input_ports ();
+  initialize_custom_binary_input_ports ();
+  initialize_bytevector_output_ports ();
+  initialize_custom_binary_output_ports ();
+}
diff --git a/libguile/r6rs-ports.h b/libguile/r6rs-ports.h
new file mode 100644
index 000000000..e29d96200
--- /dev/null
+++ b/libguile/r6rs-ports.h
@@ -0,0 +1,43 @@
+#ifndef SCM_R6RS_PORTS_H
+#define SCM_R6RS_PORTS_H
+
+/* Copyright (C) 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 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
+ */
+
+
+
+#include "libguile/__scm.h"
+
+/* R6RS I/O Ports.  */
+
+SCM_API SCM scm_eof_object (void);
+SCM_API SCM scm_open_bytevector_input_port (SCM, SCM);
+SCM_API SCM scm_make_custom_binary_input_port (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_get_u8 (SCM);
+SCM_API SCM scm_lookahead_u8 (SCM);
+SCM_API SCM scm_get_bytevector_n (SCM, SCM);
+SCM_API SCM scm_get_bytevector_n_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_get_bytevector_some (SCM);
+SCM_API SCM scm_get_bytevector_all (SCM);
+SCM_API SCM scm_put_u8 (SCM, SCM);
+SCM_API SCM scm_put_bytevector (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_open_bytevector_output_port (SCM);
+SCM_API SCM scm_make_custom_binary_output_port (SCM, SCM, SCM, SCM, SCM);
+
+SCM_API void scm_init_r6rs_ports (void);
+
+#endif /* SCM_R6RS_PORTS_H */
diff --git a/libguile/read.c b/libguile/read.c
index 61806f263..3493ba03f 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -182,6 +182,7 @@ static SCM *scm_read_hash_procedures;
 
 /* Read an SCSH block comment.  */
 static inline SCM scm_read_scsh_block_comment (int chr, SCM port);
+static SCM scm_read_commented_expression (int chr, SCM port);
 
 /* Read from PORT until a delimiter (e.g., a whitespace) is read.  Return
    zero if the whole token fits in BUF, non-zero otherwise.  */
@@ -257,6 +258,9 @@ flush_ws (SCM port, const char *eoferr)
 	  case '!':
 	    scm_read_scsh_block_comment (c, port);
 	    break;
+	  case ';':
+	    scm_read_commented_expression (c, port);
+	    break;
 	  default:
 	    scm_ungetc (c, port);
 	    return '#';
@@ -700,6 +704,65 @@ scm_read_quote (int chr, SCM port)
   return p;
 }
 
+SCM_SYMBOL (sym_syntax, "syntax");
+SCM_SYMBOL (sym_quasisyntax, "quasisyntax");
+SCM_SYMBOL (sym_unsyntax, "unsyntax");
+SCM_SYMBOL (sym_unsyntax_splicing, "unsyntax-splicing");
+
+static SCM
+scm_read_syntax (int chr, SCM port)
+{
+  SCM p;
+  long line = SCM_LINUM (port);
+  int column = SCM_COL (port) - 1;
+
+  switch (chr)
+    {
+    case '`':
+      p = sym_quasisyntax;
+      break;
+
+    case '\'':
+      p = sym_syntax;
+      break;
+
+    case ',':
+      {
+	int c;
+
+	c = scm_getc (port);
+	if ('@' == c)
+	  p = sym_unsyntax_splicing;
+	else
+	  {
+	    scm_ungetc (c, port);
+	    p = sym_unsyntax;
+	  }
+	break;
+      }
+
+    default:
+      fprintf (stderr, "%s: unhandled syntax character (%i)\n",
+	       "scm_read_syntax", chr);
+      abort ();
+    }
+
+  p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
+  if (SCM_RECORD_POSITIONS_P)
+    scm_whash_insert (scm_source_whash, p,
+		      scm_make_srcprops (line, column,
+					 SCM_FILENAME (port),
+					 SCM_COPY_SOURCE_P
+					 ? (scm_cons2 (SCM_CAR (p),
+						       SCM_CAR (SCM_CDR (p)),
+						       SCM_EOL))
+					 : SCM_UNDEFINED,
+					 SCM_EOL));
+
+
+  return p;
+}
+
 static inline SCM
 scm_read_semicolon_comment (int chr, SCM port)
 {
@@ -863,6 +926,20 @@ scm_read_scsh_block_comment (int chr, SCM port)
 }
 
 static SCM
+scm_read_commented_expression (int chr, SCM port)
+{
+  int c;
+  
+  c = flush_ws (port, (char *) NULL);
+  if (EOF == c)
+    scm_i_input_error ("read_commented_expression", port,
+                       "no expression after #; comment", SCM_EOL);
+  scm_ungetc (c, port);
+  scm_read_expression (port);
+  return SCM_UNSPECIFIED;
+}
+
+static SCM
 scm_read_extended_symbol (int chr, SCM port)
 {
   /* Guile's extended symbol read syntax looks like this:
@@ -1023,6 +1100,12 @@ scm_read_sharp (int chr, SCM port)
       return (scm_read_extended_symbol (chr, port));
     case '!':
       return (scm_read_scsh_block_comment (chr, port));
+    case ';':
+      return (scm_read_commented_expression (chr, port));
+    case '`':
+    case '\'':
+    case ',':
+      return (scm_read_syntax (chr, port));
     default:
       result = scm_read_sharp_extension (chr, port);
       if (scm_is_eq (result, SCM_UNSPECIFIED))
diff --git a/libguile/script.c b/libguile/script.c
index 14691c738..c61e85a8d 100644
--- a/libguile/script.c
+++ b/libguile/script.c
@@ -29,6 +29,7 @@
 #include "libguile/eval.h"
 #include "libguile/feature.h"
 #include "libguile/load.h"
+#include "libguile/private-gc.h" /* scm_getenv_int */
 #include "libguile/read.h"
 #include "libguile/script.h"
 #include "libguile/strings.h"
@@ -376,6 +377,10 @@ scm_shell_usage (int fatal, char *message)
            "  --no-debug     start with normal evaluator\n"
            "                 Default is to enable debugging for interactive\n"
            "                 use, but not for `-s' and `-c'.\n"
+           "  --autocompile  compile source files automatically\n"
+           "  --no-autocompile  disable automatic source file compilation\n"
+           "                 Default is to enable autocompilation of source\n"
+           "                 files.\n"
 	   "  -q             inhibit loading of user init file\n"
            "  --emacs        enable Emacs protocol (experimental)\n"
 	   "  --use-srfi=LS  load SRFI modules for the SRFIs in LS,\n"
@@ -404,6 +409,7 @@ SCM_SYMBOL (sym_quit, "quit");
 SCM_SYMBOL (sym_use_srfis, "use-srfis");
 SCM_SYMBOL (sym_load_path, "%load-path");
 SCM_SYMBOL (sym_set_x, "set!");
+SCM_SYMBOL (sym_sys_load_should_autocompile, "%load-should-autocompile");
 SCM_SYMBOL (sym_cons, "cons");
 SCM_SYMBOL (sym_at, "@");
 SCM_SYMBOL (sym_atat, "@@");
@@ -448,6 +454,8 @@ scm_compile_shell_switches (int argc, char **argv)
   int use_emacs_interface = 0;
   int turn_on_debugging = 0;
   int dont_turn_on_debugging = 0;
+  int turn_on_autocompile = 0;
+  int dont_turn_on_autocompile = 0;
 
   int i;
   char *argv0 = guile;
@@ -584,6 +592,18 @@ scm_compile_shell_switches (int argc, char **argv)
 	  turn_on_debugging = 0;
 	}
 
+      else if (! strcmp (argv[i], "--autocompile"))
+	{
+	  turn_on_autocompile = 1;
+	  dont_turn_on_autocompile = 0;
+	}
+
+      else if (! strcmp (argv[i], "--no-autocompile"))
+	{
+	  dont_turn_on_autocompile = 1;
+	  turn_on_autocompile = 0;
+	}
+
       else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */ 
 	use_emacs_interface = 1;
 
@@ -701,6 +721,16 @@ scm_compile_shell_switches (int argc, char **argv)
       tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
     }
 
+  /* If GUILE_AUTO_COMPILE is not set and no args are given, default to
+     autocompilation. */
+  if (turn_on_autocompile || (scm_getenv_int ("GUILE_AUTO_COMPILE", 1)
+                              && !dont_turn_on_autocompile))
+    {
+      tail = scm_cons (scm_list_3 (sym_set_x, sym_sys_load_should_autocompile,
+                                   SCM_BOOL_T),
+                       tail);
+    }
+
   /* If debugging was requested, or we are interactive and debugging
      was not explicitly turned off, turn on debugging. */
   if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
diff --git a/libguile/unif.c b/libguile/unif.c
index daf085007..4013f29b8 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -770,6 +770,53 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
 }
 #undef FUNC_NAME
 
+SCM
+scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
+                                 size_t byte_len)
+#define FUNC_NAME "scm_from_contiguous_typed_array"
+{
+  size_t k, rlen = 1;
+  scm_t_array_dim *s;
+  creator_proc *creator;
+  SCM ra;
+  scm_t_array_handle h;
+  void *base;
+  size_t sz;
+  
+  creator = type_to_creator (type);
+  ra = scm_i_shap2ra (bounds);
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+  s = SCM_I_ARRAY_DIMS (ra);
+  k = SCM_I_ARRAY_NDIM (ra);
+
+  while (k--)
+    {
+      s[k].inc = rlen;
+      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
+      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
+    }
+  SCM_I_ARRAY_V (ra) = creator (scm_from_size_t (rlen), SCM_UNDEFINED);
+
+
+  scm_array_get_handle (ra, &h);
+  base = scm_array_handle_uniform_writable_elements (&h);
+  sz = scm_array_handle_uniform_element_size (&h);
+  scm_array_handle_release (&h);
+
+  if (byte_len % sz)
+    SCM_MISC_ERROR ("byte length not a multiple of the unit size", SCM_EOL);
+  if (byte_len / sz != rlen)
+    SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
+
+  memcpy (base, bytes, byte_len);
+
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+      return SCM_I_ARRAY_V (ra);
+  return ra;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
 	    (SCM fill, SCM bounds),
 	    "Create and return an array.")
diff --git a/libguile/unif.h b/libguile/unif.h
index a09bfc921..1d01f807d 100644
--- a/libguile/unif.h
+++ b/libguile/unif.h
@@ -45,6 +45,9 @@ SCM_API SCM scm_array_p (SCM v, SCM prot);
 SCM_API SCM scm_typed_array_p (SCM v, SCM type);
 SCM_API SCM scm_make_array (SCM fill, SCM bounds);
 SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
+SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
+                                             const void *bytes,
+                                             size_t byte_len);
 SCM_API SCM scm_array_rank (SCM ra);
 SCM_API size_t scm_c_array_rank (SCM ra);
 SCM_API SCM scm_array_dimensions (SCM ra);
diff --git a/libguile/validate.h b/libguile/validate.h
index e05b7dd83..c362c02f3 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -3,7 +3,7 @@
 #ifndef SCM_VALIDATE_H
 #define SCM_VALIDATE_H
 
-/* Copyright (C) 1999,2000,2001, 2002, 2004, 2006, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2002, 2004, 2006, 2007, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -150,6 +150,9 @@
     cvar = scm_to_bool (flag); \
   } while (0)
 
+#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj)		\
+  SCM_VALIDATE_SMOB ((_pos), (_obj), bytevector)
+
 #define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CHARP, "character")
 
 #define SCM_VALIDATE_CHAR_COPY(pos, scm, cvar) \
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index f43f8c7fe..34764c659 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -212,10 +212,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
     finish_args = SCM_EOL;
     goto vm_error;
 
-  vm_error_no_such_module:
-    err_msg  = scm_from_locale_string ("VM: No such module: ~A");
-    goto vm_error;
-
 #if VM_CHECK_IP
   vm_error_invalid_address:
     err_msg  = scm_from_locale_string ("VM: Invalid program address");
diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index 515001d61..50569e01a 100644
--- a/libguile/vm-i-loader.c
+++ b/libguile/vm-i-loader.c
@@ -15,6 +15,7 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
+/* FIXME! Need to check that the fetch is within the current program */
 
 /* This file is included in vm_engine.c */
 
@@ -124,29 +125,7 @@ VM_DEFINE_INSTRUCTION (66, link_now, "link-now", 0, 1, 1)
   SCM what;
   POP (what);
   SYNC_REGISTER ();
-  if (SCM_LIKELY (SCM_SYMBOLP (what)))
-    {
-      PUSH (scm_lookup (what)); /* might longjmp */
-    }
-  else
-    {
-      SCM mod;
-      /* compilation of @ or @@
-         `what' is a three-element list: (MODNAME SYM INTERFACE?)
-         INTERFACE? is #t if we compiled @ or #f if we compiled @@
-      */
-      mod = scm_resolve_module (SCM_CAR (what));
-      if (scm_is_true (SCM_CADDR (what)))
-        mod = scm_module_public_interface (mod);
-      if (SCM_FALSEP (mod))
-        {
-          finish_args = scm_list_1 (SCM_CAR (what));
-          goto vm_error_no_such_module;
-        }
-      /* might longjmp */
-      PUSH (scm_module_lookup (mod, SCM_CADR (what)));
-    }
-      
+  PUSH (resolve_variable (what, scm_current_module ()));
   NEXT;
 }
 
@@ -165,6 +144,19 @@ VM_DEFINE_LOADER (67, define, "define")
   NEXT;
 }
 
+VM_DEFINE_LOADER (68, load_array, "load-array")
+{
+  SCM type, shape;
+  size_t len;
+  FETCH_LENGTH (len);
+  POP (shape);
+  POP (type);
+  SYNC_REGISTER ();
+  PUSH (scm_from_contiguous_typed_array (type, shape, ip, len));
+  ip += len;
+  NEXT;
+}
+
 /*
 (defun renumber-ops ()
   "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 42f2b1973..36ff5bde8 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -278,47 +278,12 @@ VM_DEFINE_INSTRUCTION (25, toplevel_ref, "toplevel-ref", 1, 0, 1)
   if (!SCM_VARIABLEP (what)) 
     {
       SYNC_REGISTER ();
-      if (SCM_LIKELY (SCM_SYMBOLP (what))) 
-        {
-          SCM mod = SCM_EOL;
-          if (SCM_LIKELY (scm_module_system_booted_p
-                          && scm_is_true ((mod = scm_program_module (program)))))
-            /* might longjmp */
-            what = scm_module_lookup (mod, what);
-          else
-            {
-              SCM v = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
-              if (scm_is_false (v))
-                SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (what));
-              else
-                what = v;
-            }
-        }
-      else
-        {
-          SCM mod;
-          /* compilation of @ or @@
-             `what' is a three-element list: (MODNAME SYM INTERFACE?)
-             INTERFACE? is #t if we compiled @ or #f if we compiled @@
-          */
-          mod = scm_resolve_module (SCM_CAR (what));
-          if (scm_is_true (SCM_CADDR (what)))
-            mod = scm_module_public_interface (mod);
-          if (SCM_FALSEP (mod))
-            {
-              finish_args = scm_list_1 (mod);
-              goto vm_error_no_such_module;
-            }
-          /* might longjmp */
-          what = scm_module_lookup (mod, SCM_CADR (what));
-        }
-          
+      what = resolve_variable (what, scm_program_module (program));
       if (!VARIABLE_BOUNDP (what))
         {
           finish_args = scm_list_1 (what);
           goto vm_error_unbound;
         }
-
       OBJECT_SET (objnum, what);
     }
 
@@ -367,41 +332,7 @@ VM_DEFINE_INSTRUCTION (29, toplevel_set, "toplevel-set", 1, 1, 0)
   if (!SCM_VARIABLEP (what)) 
     {
       SYNC_BEFORE_GC ();
-      if (SCM_LIKELY (SCM_SYMBOLP (what))) 
-        {
-          SCM mod = SCM_EOL;
-          if (SCM_LIKELY (scm_module_system_booted_p
-                          && scm_is_true ((mod = scm_program_module (program)))))
-            /* might longjmp */
-            what = scm_module_lookup (mod, what);
-          else
-            {
-              SCM v = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
-              if (scm_is_false (v))
-                SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (what));
-              else
-                what = v;
-            }
-        }
-      else
-        {
-          SCM mod;
-          /* compilation of @ or @@
-             `what' is a three-element list: (MODNAME SYM INTERFACE?)
-             INTERFACE? is #t if we compiled @ or #f if we compiled @@
-          */
-          mod = scm_resolve_module (SCM_CAR (what));
-          if (scm_is_true (SCM_CADDR (what)))
-            mod = scm_module_public_interface (mod);
-          if (SCM_FALSEP (mod))
-            {
-              finish_args = scm_list_1 (what);
-              goto vm_error_no_such_module;
-            }
-          /* might longjmp */
-          what = scm_module_lookup (mod, SCM_CADR (what));
-        }
-
+      what = resolve_variable (what, scm_program_module (program));
       OBJECT_SET (objnum, what);
     }
 
@@ -1131,6 +1062,62 @@ VM_DEFINE_INSTRUCTION (51, truncate_values, "truncate-values", 2, -1, -1)
   NEXT;
 }
 
+VM_DEFINE_INSTRUCTION (52, long_object_ref, "long-object-ref", 2, 0, 1)
+{
+  unsigned int objnum = FETCH ();
+  objnum <<= 8;
+  objnum += FETCH ();
+  CHECK_OBJECT (objnum);
+  PUSH (OBJECT_REF (objnum));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (53, long_toplevel_ref, "long-toplevel-ref", 2, 0, 1)
+{
+  SCM what;
+  unsigned int objnum = FETCH ();
+  objnum <<= 8;
+  objnum += FETCH ();
+  CHECK_OBJECT (objnum);
+  what = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (what)) 
+    {
+      SYNC_REGISTER ();
+      what = resolve_variable (what, scm_program_module (program));
+      if (!VARIABLE_BOUNDP (what))
+        {
+          finish_args = scm_list_1 (what);
+          goto vm_error_unbound;
+        }
+      OBJECT_SET (objnum, what);
+    }
+
+  PUSH (VARIABLE_REF (what));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (54, long_toplevel_set, "long-toplevel-set", 2, 1, 0)
+{
+  SCM what;
+  unsigned int objnum = FETCH ();
+  objnum <<= 8;
+  objnum += FETCH ();
+  CHECK_OBJECT (objnum);
+  what = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (what)) 
+    {
+      SYNC_BEFORE_GC ();
+      what = resolve_variable (what, scm_program_module (program));
+      OBJECT_SET (objnum, what);
+    }
+
+  VARIABLE_SET (what, *sp);
+  DROP ();
+  NEXT;
+}
+
 /*
 (defun renumber-ops ()
   "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
diff --git a/libguile/vm.c b/libguile/vm.c
index 081a691ff..f708b2108 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -267,6 +267,43 @@ vm_make_boot_program (long nargs)
  * VM
  */
 
+static SCM
+resolve_variable (SCM what, SCM program_module)
+{
+  if (SCM_LIKELY (SCM_SYMBOLP (what))) 
+    {
+      if (SCM_LIKELY (scm_module_system_booted_p
+                      && scm_is_true (program_module)))
+        /* might longjmp */
+        return scm_module_lookup (program_module, what);
+      else
+        {
+          SCM v = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
+          if (scm_is_false (v))
+            scm_misc_error (NULL, "unbound variable: ~S", scm_list_1 (what));
+          else
+            return v;
+        }
+    }
+  else
+    {
+      SCM mod;
+      /* compilation of @ or @@
+         `what' is a three-element list: (MODNAME SYM INTERFACE?)
+         INTERFACE? is #t if we compiled @ or #f if we compiled @@
+      */
+      mod = scm_resolve_module (SCM_CAR (what));
+      if (scm_is_true (SCM_CADDR (what)))
+        mod = scm_module_public_interface (mod);
+      if (SCM_FALSEP (mod))
+        scm_misc_error (NULL, "no such module: ~S",
+                        scm_list_1 (SCM_CAR (what)));
+      /* might longjmp */
+      return scm_module_lookup (mod, SCM_CADR (what));
+    }
+}
+  
+
 #define VM_DEFAULT_STACK_SIZE	(16 * 1024)
 
 #define VM_NAME   vm_regular_engine
diff --git a/m4/byteswap.m4 b/m4/byteswap.m4
new file mode 100644
index 000000000..ad13f2286
--- /dev/null
+++ b/m4/byteswap.m4
@@ -0,0 +1,18 @@
+# byteswap.m4 serial 3
+dnl Copyright (C) 2005, 2007, 2009 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.
+
+dnl Written by Oskar Liljeblad.
+
+AC_DEFUN([gl_BYTESWAP],
+[
+  dnl Prerequisites of lib/byteswap.in.h.
+  AC_CHECK_HEADERS([byteswap.h], [
+    BYTESWAP_H=''
+  ], [
+    BYTESWAP_H='byteswap.h'
+  ])
+  AC_SUBST([BYTESWAP_H])
+])
diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4
index c7cfb83dd..0fbe11969 100644
--- a/m4/gnulib-cache.m4
+++ b/m4/gnulib-cache.m4
@@ -15,13 +15,14 @@
 
 
 # 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 --libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild count-one-bits environ extensions flock fpieee full-read full-write lib-symbol-visibility putenv stdlib strcase strftime
+#   gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild byteswap count-one-bits environ extensions flock fpieee full-read full-write iconv_open-utf lib-symbol-visibility libunistring putenv stdlib strcase strftime striconveh string
 
 # Specification in the form of a few gnulib-tool.m4 macro invocations:
 gl_LOCAL_DIR([])
 gl_MODULES([
   alloca-opt
   autobuild
+  byteswap
   count-one-bits
   environ
   extensions
@@ -29,11 +30,15 @@ gl_MODULES([
   fpieee
   full-read
   full-write
+  iconv_open-utf
   lib-symbol-visibility
+  libunistring
   putenv
   stdlib
   strcase
   strftime
+  striconveh
+  string
 ])
 gl_AVOID([])
 gl_SOURCE_BASE([lib])
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index b6d10a862..8f775107e 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -25,6 +25,7 @@ AC_DEFUN([gl_EARLY],
   m4_pattern_allow([^gl_LIBOBJS$])dnl a variable
   m4_pattern_allow([^gl_LTLIBOBJS$])dnl a variable
   AC_REQUIRE([AC_PROG_RANLIB])
+  AC_REQUIRE([AM_PROG_CC_C_O])
   AB_INIT
   AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
   AC_REQUIRE([gl_FP_IEEE])
@@ -44,13 +45,19 @@ AC_DEFUN([gl_INIT],
   gl_COMMON
   gl_source_base='lib'
   gl_FUNC_ALLOCA
+  gl_BYTESWAP
   gl_COUNT_ONE_BITS
   gl_ENVIRON
   gl_UNISTD_MODULE_INDICATOR([environ])
   gl_FUNC_FLOCK
   gl_HEADER_SYS_FILE_MODULE_INDICATOR([flock])
+  AM_ICONV
+  gl_ICONV_H
+  gl_FUNC_ICONV_OPEN
+  gl_FUNC_ICONV_OPEN_UTF
   gl_INLINE
   gl_VISIBILITY
+  gl_LIBUNISTRING
   gl_LOCALCHARSET
   LOCALCHARSET_TESTS_ENVIRONMENT="CHARSETALIASDIR=\"\$(top_builddir)/$gl_source_base\""
   AC_SUBST([LOCALCHARSET_TESTS_ENVIRONMENT])
@@ -73,12 +80,21 @@ AC_DEFUN([gl_INIT],
   gl_STDLIB_H
   gl_STRCASE
   gl_FUNC_GNU_STRFTIME
+  if test $gl_cond_libtool = false; then
+    gl_ltlibdeps="$gl_ltlibdeps $LTLIBICONV"
+    gl_libdeps="$gl_libdeps $LIBICONV"
+  fi
+  gl_HEADER_STRING_H
   gl_HEADER_STRINGS_H
   gl_HEADER_SYS_FILE_H
   AC_PROG_MKDIR_P
   gl_HEADER_TIME_H
   gl_TIME_R
   gl_UNISTD_H
+  gl_MODULE_INDICATOR([unistr/u8-mbtouc])
+  gl_MODULE_INDICATOR([unistr/u8-mbtouc-unsafe])
+  gl_MODULE_INDICATOR([unistr/u8-mbtoucr])
+  gl_MODULE_INDICATOR([unistr/u8-uctomb])
   gl_WCHAR_H
   gl_FUNC_WRITE
   gl_UNISTD_MODULE_INDICATOR([write])
@@ -210,8 +226,16 @@ AC_DEFUN([gltests_LIBSOURCES], [
 # This macro records the list of files which have been installed by
 # gnulib-tool and may be removed by future gnulib-tool invocations.
 AC_DEFUN([gl_FILE_LIST], [
+  build-aux/config.rpath
   build-aux/link-warning.h
   lib/alloca.in.h
+  lib/byteswap.in.h
+  lib/c-ctype.c
+  lib/c-ctype.h
+  lib/c-strcase.h
+  lib/c-strcasecmp.c
+  lib/c-strcaseeq.h
+  lib/c-strncasecmp.c
   lib/config.charset
   lib/count-one-bits.h
   lib/flock.c
@@ -219,6 +243,15 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/full-read.h
   lib/full-write.c
   lib/full-write.h
+  lib/iconv.c
+  lib/iconv.in.h
+  lib/iconv_close.c
+  lib/iconv_open-aix.gperf
+  lib/iconv_open-hpux.gperf
+  lib/iconv_open-irix.gperf
+  lib/iconv_open-osf.gperf
+  lib/iconv_open.c
+  lib/iconveh.h
   lib/localcharset.c
   lib/localcharset.h
   lib/malloc.c
@@ -239,18 +272,32 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/streq.h
   lib/strftime.c
   lib/strftime.h
+  lib/striconveh.c
+  lib/striconveh.h
+  lib/string.in.h
   lib/strings.in.h
   lib/strncasecmp.c
   lib/sys_file.in.h
   lib/time.in.h
   lib/time_r.c
   lib/unistd.in.h
+  lib/unistr.h
+  lib/unistr/u8-mbtouc-aux.c
+  lib/unistr/u8-mbtouc-unsafe-aux.c
+  lib/unistr/u8-mbtouc-unsafe.c
+  lib/unistr/u8-mbtouc.c
+  lib/unistr/u8-mbtoucr.c
+  lib/unistr/u8-prev.c
+  lib/unistr/u8-uctomb-aux.c
+  lib/unistr/u8-uctomb.c
+  lib/unitypes.h
   lib/verify.h
   lib/wchar.in.h
   lib/write.c
   m4/00gnulib.m4
   m4/alloca.m4
   m4/autobuild.m4
+  m4/byteswap.m4
   m4/codeset.m4
   m4/count-one-bits.m4
   m4/environ.m4
@@ -259,8 +306,15 @@ AC_DEFUN([gl_FILE_LIST], [
   m4/fpieee.m4
   m4/glibc21.m4
   m4/gnulib-common.m4
+  m4/iconv.m4
+  m4/iconv_h.m4
+  m4/iconv_open.m4
   m4/include_next.m4
   m4/inline.m4
+  m4/lib-ld.m4
+  m4/lib-link.m4
+  m4/lib-prefix.m4
+  m4/libunistring.m4
   m4/localcharset.m4
   m4/locale-fr.m4
   m4/locale-ja.m4
@@ -281,6 +335,7 @@ AC_DEFUN([gl_FILE_LIST], [
   m4/stdlib_h.m4
   m4/strcase.m4
   m4/strftime.m4
+  m4/string_h.m4
   m4/strings_h.m4
   m4/sys_file_h.m4
   m4/time_h.m4
diff --git a/m4/iconv.m4 b/m4/iconv.m4
new file mode 100644
index 000000000..3cc626829
--- /dev/null
+++ b/m4/iconv.m4
@@ -0,0 +1,180 @@
+# iconv.m4 serial AM7 (gettext-0.18)
+dnl Copyright (C) 2000-2002, 2007-2009 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.
+
+dnl From Bruno Haible.
+
+AC_DEFUN([AM_ICONV_LINKFLAGS_BODY],
+[
+  dnl Prerequisites of AC_LIB_LINKFLAGS_BODY.
+  AC_REQUIRE([AC_LIB_PREPARE_PREFIX])
+  AC_REQUIRE([AC_LIB_RPATH])
+
+  dnl Search for libiconv and define LIBICONV, LTLIBICONV and INCICONV
+  dnl accordingly.
+  AC_LIB_LINKFLAGS_BODY([iconv])
+])
+
+AC_DEFUN([AM_ICONV_LINK],
+[
+  dnl Some systems have iconv in libc, some have it in libiconv (OSF/1 and
+  dnl those with the standalone portable GNU libiconv installed).
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+
+  dnl Search for libiconv and define LIBICONV, LTLIBICONV and INCICONV
+  dnl accordingly.
+  AC_REQUIRE([AM_ICONV_LINKFLAGS_BODY])
+
+  dnl Add $INCICONV to CPPFLAGS before performing the following checks,
+  dnl because if the user has installed libiconv and not disabled its use
+  dnl via --without-libiconv-prefix, he wants to use it. The first
+  dnl AC_TRY_LINK will then fail, the second AC_TRY_LINK will succeed.
+  am_save_CPPFLAGS="$CPPFLAGS"
+  AC_LIB_APPENDTOVAR([CPPFLAGS], [$INCICONV])
+
+  AC_CACHE_CHECK([for iconv], [am_cv_func_iconv], [
+    am_cv_func_iconv="no, consider installing GNU libiconv"
+    am_cv_lib_iconv=no
+    AC_TRY_LINK([#include <stdlib.h>
+#include <iconv.h>],
+      [iconv_t cd = iconv_open("","");
+       iconv(cd,NULL,NULL,NULL,NULL);
+       iconv_close(cd);],
+      [am_cv_func_iconv=yes])
+    if test "$am_cv_func_iconv" != yes; then
+      am_save_LIBS="$LIBS"
+      LIBS="$LIBS $LIBICONV"
+      AC_TRY_LINK([#include <stdlib.h>
+#include <iconv.h>],
+        [iconv_t cd = iconv_open("","");
+         iconv(cd,NULL,NULL,NULL,NULL);
+         iconv_close(cd);],
+        [am_cv_lib_iconv=yes]
+        [am_cv_func_iconv=yes])
+      LIBS="$am_save_LIBS"
+    fi
+  ])
+  if test "$am_cv_func_iconv" = yes; then
+    AC_CACHE_CHECK([for working iconv], [am_cv_func_iconv_works], [
+      dnl This tests against bugs in AIX 5.1 and HP-UX 11.11.
+      am_save_LIBS="$LIBS"
+      if test $am_cv_lib_iconv = yes; then
+        LIBS="$LIBS $LIBICONV"
+      fi
+      AC_TRY_RUN([
+#include <iconv.h>
+#include <string.h>
+int main ()
+{
+  /* Test against AIX 5.1 bug: Failures are not distinguishable from successful
+     returns.  */
+  {
+    iconv_t cd_utf8_to_88591 = iconv_open ("ISO8859-1", "UTF-8");
+    if (cd_utf8_to_88591 != (iconv_t)(-1))
+      {
+        static const char input[] = "\342\202\254"; /* EURO SIGN */
+        char buf[10];
+        const char *inptr = input;
+        size_t inbytesleft = strlen (input);
+        char *outptr = buf;
+        size_t outbytesleft = sizeof (buf);
+        size_t res = iconv (cd_utf8_to_88591,
+                            (char **) &inptr, &inbytesleft,
+                            &outptr, &outbytesleft);
+        if (res == 0)
+          return 1;
+      }
+  }
+#if 0 /* This bug could be worked around by the caller.  */
+  /* Test against HP-UX 11.11 bug: Positive return value instead of 0.  */
+  {
+    iconv_t cd_88591_to_utf8 = iconv_open ("utf8", "iso88591");
+    if (cd_88591_to_utf8 != (iconv_t)(-1))
+      {
+        static const char input[] = "\304rger mit b\366sen B\374bchen ohne Augenma\337";
+        char buf[50];
+        const char *inptr = input;
+        size_t inbytesleft = strlen (input);
+        char *outptr = buf;
+        size_t outbytesleft = sizeof (buf);
+        size_t res = iconv (cd_88591_to_utf8,
+                            (char **) &inptr, &inbytesleft,
+                            &outptr, &outbytesleft);
+        if ((int)res > 0)
+          return 1;
+      }
+  }
+#endif
+  /* Test against HP-UX 11.11 bug: No converter from EUC-JP to UTF-8 is
+     provided.  */
+  if (/* Try standardized names.  */
+      iconv_open ("UTF-8", "EUC-JP") == (iconv_t)(-1)
+      /* Try IRIX, OSF/1 names.  */
+      && iconv_open ("UTF-8", "eucJP") == (iconv_t)(-1)
+      /* Try AIX names.  */
+      && iconv_open ("UTF-8", "IBM-eucJP") == (iconv_t)(-1)
+      /* Try HP-UX names.  */
+      && iconv_open ("utf8", "eucJP") == (iconv_t)(-1))
+    return 1;
+  return 0;
+}], [am_cv_func_iconv_works=yes], [am_cv_func_iconv_works=no],
+        [case "$host_os" in
+           aix* | hpux*) am_cv_func_iconv_works="guessing no" ;;
+           *)            am_cv_func_iconv_works="guessing yes" ;;
+         esac])
+      LIBS="$am_save_LIBS"
+    ])
+    case "$am_cv_func_iconv_works" in
+      *no) am_func_iconv=no am_cv_lib_iconv=no ;;
+      *)   am_func_iconv=yes ;;
+    esac
+  else
+    am_func_iconv=no am_cv_lib_iconv=no
+  fi
+  if test "$am_func_iconv" = yes; then
+    AC_DEFINE([HAVE_ICONV], [1],
+      [Define if you have the iconv() function and it works.])
+  fi
+  if test "$am_cv_lib_iconv" = yes; then
+    AC_MSG_CHECKING([how to link with libiconv])
+    AC_MSG_RESULT([$LIBICONV])
+  else
+    dnl If $LIBICONV didn't lead to a usable library, we don't need $INCICONV
+    dnl either.
+    CPPFLAGS="$am_save_CPPFLAGS"
+    LIBICONV=
+    LTLIBICONV=
+  fi
+  AC_SUBST([LIBICONV])
+  AC_SUBST([LTLIBICONV])
+])
+
+AC_DEFUN([AM_ICONV],
+[
+  AM_ICONV_LINK
+  if test "$am_cv_func_iconv" = yes; then
+    AC_MSG_CHECKING([for iconv declaration])
+    AC_CACHE_VAL([am_cv_proto_iconv], [
+      AC_TRY_COMPILE([
+#include <stdlib.h>
+#include <iconv.h>
+extern
+#ifdef __cplusplus
+"C"
+#endif
+#if defined(__STDC__) || defined(__cplusplus)
+size_t iconv (iconv_t cd, char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft);
+#else
+size_t iconv();
+#endif
+], [], [am_cv_proto_iconv_arg1=""], [am_cv_proto_iconv_arg1="const"])
+      am_cv_proto_iconv="extern size_t iconv (iconv_t cd, $am_cv_proto_iconv_arg1 char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft);"])
+    am_cv_proto_iconv=`echo "[$]am_cv_proto_iconv" | tr -s ' ' | sed -e 's/( /(/'`
+    AC_MSG_RESULT([${ac_t:-
+         }$am_cv_proto_iconv])
+    AC_DEFINE_UNQUOTED([ICONV_CONST], [$am_cv_proto_iconv_arg1],
+      [Define as const if the declaration of iconv() needs const.])
+  fi
+])
diff --git a/m4/iconv_h.m4 b/m4/iconv_h.m4
new file mode 100644
index 000000000..bc05b0551
--- /dev/null
+++ b/m4/iconv_h.m4
@@ -0,0 +1,34 @@
+# iconv_h.m4 serial 4
+dnl Copyright (C) 2007-2008 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_ICONV_H],
+[
+  AC_REQUIRE([gl_ICONV_H_DEFAULTS])
+  gl_CHECK_NEXT_HEADERS([iconv.h])
+])
+
+dnl Unconditionally enables the replacement of <iconv.h>.
+AC_DEFUN([gl_REPLACE_ICONV_H],
+[
+  AC_REQUIRE([gl_ICONV_H_DEFAULTS])
+  ICONV_H='iconv.h'
+])
+
+AC_DEFUN([gl_ICONV_MODULE_INDICATOR],
+[
+  dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+  AC_REQUIRE([gl_ICONV_H_DEFAULTS])
+  GNULIB_[]m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=1
+])
+
+AC_DEFUN([gl_ICONV_H_DEFAULTS],
+[
+  dnl Assume proper GNU behavior unless another module says otherwise.
+  REPLACE_ICONV=0;      AC_SUBST([REPLACE_ICONV])
+  REPLACE_ICONV_OPEN=0; AC_SUBST([REPLACE_ICONV_OPEN])
+  REPLACE_ICONV_UTF=0;  AC_SUBST([REPLACE_ICONV_UTF])
+  ICONV_H='';           AC_SUBST([ICONV_H])
+])
diff --git a/m4/iconv_open.m4 b/m4/iconv_open.m4
new file mode 100644
index 000000000..c7b948e90
--- /dev/null
+++ b/m4/iconv_open.m4
@@ -0,0 +1,237 @@
+# iconv_open.m4 serial 5
+dnl Copyright (C) 2007-2009 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_ICONV_OPEN],
+[
+  AC_REQUIRE([AM_ICONV])
+  AC_REQUIRE([AC_CANONICAL_HOST])
+  AC_REQUIRE([gl_ICONV_H_DEFAULTS])
+  if test "$am_cv_func_iconv" = yes; then
+    dnl Test whether iconv_open accepts standardized encoding names.
+    dnl We know that GNU libiconv and GNU libc do.
+    AC_EGREP_CPP([gnu_iconv], [
+      #include <iconv.h>
+      #if defined _LIBICONV_VERSION || defined __GLIBC__
+       gnu_iconv
+      #endif
+      ], [gl_func_iconv_gnu=yes], [gl_func_iconv_gnu=no])
+    if test $gl_func_iconv_gnu = no; then
+      iconv_flavor=
+      case "$host_os" in
+        aix*)  iconv_flavor=ICONV_FLAVOR_AIX ;;
+        irix*) iconv_flavor=ICONV_FLAVOR_IRIX ;;
+        hpux*) iconv_flavor=ICONV_FLAVOR_HPUX ;;
+        osf*)  iconv_flavor=ICONV_FLAVOR_OSF ;;
+      esac
+      if test -n "$iconv_flavor"; then
+        AC_DEFINE_UNQUOTED([ICONV_FLAVOR], [$iconv_flavor],
+          [Define to a symbolic name denoting the flavor of iconv_open()
+           implementation.])
+        gl_REPLACE_ICONV_OPEN
+      fi
+    fi
+  fi
+])
+
+AC_DEFUN([gl_REPLACE_ICONV_OPEN],
+[
+  gl_REPLACE_ICONV_H
+  REPLACE_ICONV_OPEN=1
+  AC_LIBOBJ([iconv_open])
+])
+
+AC_DEFUN([gl_FUNC_ICONV_OPEN_UTF],
+[
+  AC_REQUIRE([gl_FUNC_ICONV_OPEN])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_REQUIRE([gl_ICONV_H_DEFAULTS])
+  if test "$am_cv_func_iconv" = yes; then
+    if test -n "$am_cv_proto_iconv_arg1"; then
+      ICONV_CONST="const"
+    else
+      ICONV_CONST=
+    fi
+    AC_SUBST([ICONV_CONST])
+    AC_CACHE_CHECK([whether iconv supports conversion between UTF-8 and UTF-{16,32}{BE,LE}],
+      [gl_cv_func_iconv_supports_utf],
+      [
+        save_LIBS="$LIBS"
+        LIBS="$LIBS $LIBICONV"
+        AC_TRY_RUN([
+#include <iconv.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#define ASSERT(expr) if (!(expr)) return 1;
+int main ()
+{
+  /* Test conversion from UTF-8 to UTF-16BE with no errors.  */
+  {
+    static const char input[] =
+      "Japanese (\346\227\245\346\234\254\350\252\236) [\360\235\224\215\360\235\224\236\360\235\224\255]";
+    static const char expected[] =
+      "\000J\000a\000p\000a\000n\000e\000s\000e\000 \000(\145\345\147\054\212\236\000)\000 \000[\330\065\335\015\330\065\335\036\330\065\335\055\000]";
+    iconv_t cd;
+    char buf[100];
+    const char *inptr;
+    size_t inbytesleft;
+    char *outptr;
+    size_t outbytesleft;
+    size_t res;
+    cd = iconv_open ("UTF-16BE", "UTF-8");
+    ASSERT (cd != (iconv_t)(-1));
+    inptr = input;
+    inbytesleft = sizeof (input) - 1;
+    outptr = buf;
+    outbytesleft = sizeof (buf);
+    res = iconv (cd,
+		 (ICONV_CONST char **) &inptr, &inbytesleft,
+		 &outptr, &outbytesleft);
+    ASSERT (res == 0 && inbytesleft == 0);
+    ASSERT (outptr == buf + (sizeof (expected) - 1));
+    ASSERT (memcmp (buf, expected, sizeof (expected) - 1) == 0);
+    ASSERT (iconv_close (cd) == 0);
+  }
+  /* Test conversion from UTF-8 to UTF-16LE with no errors.  */
+  {
+    static const char input[] =
+      "Japanese (\346\227\245\346\234\254\350\252\236) [\360\235\224\215\360\235\224\236\360\235\224\255]";
+    static const char expected[] =
+      "J\000a\000p\000a\000n\000e\000s\000e\000 \000(\000\345\145\054\147\236\212)\000 \000[\000\065\330\015\335\065\330\036\335\065\330\055\335]\000";
+    iconv_t cd;
+    char buf[100];
+    const char *inptr;
+    size_t inbytesleft;
+    char *outptr;
+    size_t outbytesleft;
+    size_t res;
+    cd = iconv_open ("UTF-16LE", "UTF-8");
+    ASSERT (cd != (iconv_t)(-1));
+    inptr = input;
+    inbytesleft = sizeof (input) - 1;
+    outptr = buf;
+    outbytesleft = sizeof (buf);
+    res = iconv (cd,
+		 (ICONV_CONST char **) &inptr, &inbytesleft,
+		 &outptr, &outbytesleft);
+    ASSERT (res == 0 && inbytesleft == 0);
+    ASSERT (outptr == buf + (sizeof (expected) - 1));
+    ASSERT (memcmp (buf, expected, sizeof (expected) - 1) == 0);
+    ASSERT (iconv_close (cd) == 0);
+  }
+  /* Test conversion from UTF-8 to UTF-32BE with no errors.  */
+  {
+    static const char input[] =
+      "Japanese (\346\227\245\346\234\254\350\252\236) [\360\235\224\215\360\235\224\236\360\235\224\255]";
+    static const char expected[] =
+      "\000\000\000J\000\000\000a\000\000\000p\000\000\000a\000\000\000n\000\000\000e\000\000\000s\000\000\000e\000\000\000 \000\000\000(\000\000\145\345\000\000\147\054\000\000\212\236\000\000\000)\000\000\000 \000\000\000[\000\001\325\015\000\001\325\036\000\001\325\055\000\000\000]";
+    iconv_t cd;
+    char buf[100];
+    const char *inptr;
+    size_t inbytesleft;
+    char *outptr;
+    size_t outbytesleft;
+    size_t res;
+    cd = iconv_open ("UTF-32BE", "UTF-8");
+    ASSERT (cd != (iconv_t)(-1));
+    inptr = input;
+    inbytesleft = sizeof (input) - 1;
+    outptr = buf;
+    outbytesleft = sizeof (buf);
+    res = iconv (cd,
+		 (ICONV_CONST char **) &inptr, &inbytesleft,
+		 &outptr, &outbytesleft);
+    ASSERT (res == 0 && inbytesleft == 0);
+    ASSERT (outptr == buf + (sizeof (expected) - 1));
+    ASSERT (memcmp (buf, expected, sizeof (expected) - 1) == 0);
+    ASSERT (iconv_close (cd) == 0);
+  }
+  /* Test conversion from UTF-8 to UTF-32LE with no errors.  */
+  {
+    static const char input[] =
+      "Japanese (\346\227\245\346\234\254\350\252\236) [\360\235\224\215\360\235\224\236\360\235\224\255]";
+    static const char expected[] =
+      "J\000\000\000a\000\000\000p\000\000\000a\000\000\000n\000\000\000e\000\000\000s\000\000\000e\000\000\000 \000\000\000(\000\000\000\345\145\000\000\054\147\000\000\236\212\000\000)\000\000\000 \000\000\000[\000\000\000\015\325\001\000\036\325\001\000\055\325\001\000]\000\000\000";
+    iconv_t cd;
+    char buf[100];
+    const char *inptr;
+    size_t inbytesleft;
+    char *outptr;
+    size_t outbytesleft;
+    size_t res;
+    cd = iconv_open ("UTF-32LE", "UTF-8");
+    ASSERT (cd != (iconv_t)(-1));
+    inptr = input;
+    inbytesleft = sizeof (input) - 1;
+    outptr = buf;
+    outbytesleft = sizeof (buf);
+    res = iconv (cd,
+		 (ICONV_CONST char **) &inptr, &inbytesleft,
+		 &outptr, &outbytesleft);
+    ASSERT (res == 0 && inbytesleft == 0);
+    ASSERT (outptr == buf + (sizeof (expected) - 1));
+    ASSERT (memcmp (buf, expected, sizeof (expected) - 1) == 0);
+    ASSERT (iconv_close (cd) == 0);
+  }
+  /* Test conversion from UTF-16BE to UTF-8 with no errors.
+     This test fails on NetBSD 3.0.  */
+  {
+    static const char input[] =
+      "\000J\000a\000p\000a\000n\000e\000s\000e\000 \000(\145\345\147\054\212\236\000)\000 \000[\330\065\335\015\330\065\335\036\330\065\335\055\000]";
+    static const char expected[] =
+      "Japanese (\346\227\245\346\234\254\350\252\236) [\360\235\224\215\360\235\224\236\360\235\224\255]";
+    iconv_t cd;
+    char buf[100];
+    const char *inptr;
+    size_t inbytesleft;
+    char *outptr;
+    size_t outbytesleft;
+    size_t res;
+    cd = iconv_open ("UTF-8", "UTF-16BE");
+    ASSERT (cd != (iconv_t)(-1));
+    inptr = input;
+    inbytesleft = sizeof (input) - 1;
+    outptr = buf;
+    outbytesleft = sizeof (buf);
+    res = iconv (cd,
+		 (ICONV_CONST char **) &inptr, &inbytesleft,
+		 &outptr, &outbytesleft);
+    ASSERT (res == 0 && inbytesleft == 0);
+    ASSERT (outptr == buf + (sizeof (expected) - 1));
+    ASSERT (memcmp (buf, expected, sizeof (expected) - 1) == 0);
+    ASSERT (iconv_close (cd) == 0);
+  }
+  return 0;
+}], [gl_cv_func_iconv_supports_utf=yes], [gl_cv_func_iconv_supports_utf=no],
+          [
+           dnl We know that GNU libiconv, GNU libc, and Solaris >= 9 do.
+           dnl OSF/1 5.1 has these encodings, but inserts a BOM in the "to"
+           dnl direction.
+           gl_cv_func_iconv_supports_utf=no
+           if test $gl_func_iconv_gnu = yes; then
+             gl_cv_func_iconv_supports_utf=yes
+           else
+changequote(,)dnl
+             case "$host_os" in
+               solaris2.9 | solaris2.1[0-9]) gl_cv_func_iconv_supports_utf=yes ;;
+             esac
+changequote([,])dnl
+           fi
+          ])
+        LIBS="$save_LIBS"
+      ])
+    if test $gl_cv_func_iconv_supports_utf = no; then
+      REPLACE_ICONV_UTF=1
+      AC_DEFINE([REPLACE_ICONV_UTF], [1],
+        [Define if the iconv() functions are enhanced to handle the UTF-{16,32}{BE,LE} encodings.])
+      REPLACE_ICONV=1
+      gl_REPLACE_ICONV_OPEN
+      AC_LIBOBJ([iconv])
+      AC_LIBOBJ([iconv_close])
+    fi
+  fi
+])
diff --git a/m4/lib-ld.m4 b/m4/lib-ld.m4
new file mode 100644
index 000000000..e4863f2c9
--- /dev/null
+++ b/m4/lib-ld.m4
@@ -0,0 +1,110 @@
+# lib-ld.m4 serial 4 (gettext-0.18)
+dnl Copyright (C) 1996-2003, 2009 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.
+
+dnl Subroutines of libtool.m4,
+dnl with replacements s/AC_/AC_LIB/ and s/lt_cv/acl_cv/ to avoid collision
+dnl with libtool.m4.
+
+dnl From libtool-1.4. Sets the variable with_gnu_ld to yes or no.
+AC_DEFUN([AC_LIB_PROG_LD_GNU],
+[AC_CACHE_CHECK([if the linker ($LD) is GNU ld], [acl_cv_prog_gnu_ld],
+[# I'd rather use --version here, but apparently some GNU ld's only accept -v.
+case `$LD -v 2>&1 </dev/null` in
+*GNU* | *'with BFD'*)
+  acl_cv_prog_gnu_ld=yes ;;
+*)
+  acl_cv_prog_gnu_ld=no ;;
+esac])
+with_gnu_ld=$acl_cv_prog_gnu_ld
+])
+
+dnl From libtool-1.4. Sets the variable LD.
+AC_DEFUN([AC_LIB_PROG_LD],
+[AC_ARG_WITH([gnu-ld],
+[  --with-gnu-ld           assume the C compiler uses GNU ld [default=no]],
+test "$withval" = no || with_gnu_ld=yes, with_gnu_ld=no)
+AC_REQUIRE([AC_PROG_CC])dnl
+AC_REQUIRE([AC_CANONICAL_HOST])dnl
+# Prepare PATH_SEPARATOR.
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  echo "#! /bin/sh" >conf$$.sh
+  echo  "exit 0"   >>conf$$.sh
+  chmod +x conf$$.sh
+  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+    PATH_SEPARATOR=';'
+  else
+    PATH_SEPARATOR=:
+  fi
+  rm -f conf$$.sh
+fi
+ac_prog=ld
+if test "$GCC" = yes; then
+  # Check if gcc -print-prog-name=ld gives a path.
+  AC_MSG_CHECKING([for ld used by GCC])
+  case $host in
+  *-*-mingw*)
+    # gcc leaves a trailing carriage return which upsets mingw
+    ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
+  *)
+    ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
+  esac
+  case $ac_prog in
+    # Accept absolute paths.
+    [[\\/]* | [A-Za-z]:[\\/]*)]
+      [re_direlt='/[^/][^/]*/\.\./']
+      # Canonicalize the path of ld
+      ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
+      while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
+	ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
+      done
+      test -z "$LD" && LD="$ac_prog"
+      ;;
+  "")
+    # If it fails, then pretend we aren't using GCC.
+    ac_prog=ld
+    ;;
+  *)
+    # If it is relative, then search for the first ld in PATH.
+    with_gnu_ld=unknown
+    ;;
+  esac
+elif test "$with_gnu_ld" = yes; then
+  AC_MSG_CHECKING([for GNU ld])
+else
+  AC_MSG_CHECKING([for non-GNU ld])
+fi
+AC_CACHE_VAL([acl_cv_path_LD],
+[if test -z "$LD"; then
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
+      acl_cv_path_LD="$ac_dir/$ac_prog"
+      # Check to see if the program is GNU ld.  I'd rather use --version,
+      # but apparently some GNU ld's only accept -v.
+      # Break only if it was the GNU/non-GNU ld that we prefer.
+      case `"$acl_cv_path_LD" -v 2>&1 < /dev/null` in
+      *GNU* | *'with BFD'*)
+	test "$with_gnu_ld" != no && break ;;
+      *)
+	test "$with_gnu_ld" != yes && break ;;
+      esac
+    fi
+  done
+  IFS="$ac_save_ifs"
+else
+  acl_cv_path_LD="$LD" # Let the user override the test with a path.
+fi])
+LD="$acl_cv_path_LD"
+if test -n "$LD"; then
+  AC_MSG_RESULT([$LD])
+else
+  AC_MSG_RESULT([no])
+fi
+test -z "$LD" && AC_MSG_ERROR([no acceptable ld found in \$PATH])
+AC_LIB_PROG_LD_GNU
+])
diff --git a/m4/lib-link.m4 b/m4/lib-link.m4
new file mode 100644
index 000000000..21442033c
--- /dev/null
+++ b/m4/lib-link.m4
@@ -0,0 +1,761 @@
+# lib-link.m4 serial 19 (gettext-0.18)
+dnl Copyright (C) 2001-2009 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.
+
+dnl From Bruno Haible.
+
+AC_PREREQ([2.54])
+
+dnl AC_LIB_LINKFLAGS(name [, dependencies]) searches for libname and
+dnl the libraries corresponding to explicit and implicit dependencies.
+dnl Sets and AC_SUBSTs the LIB${NAME} and LTLIB${NAME} variables and
+dnl augments the CPPFLAGS variable.
+dnl Sets and AC_SUBSTs the LIB${NAME}_PREFIX variable to nonempty if libname
+dnl was found in ${LIB${NAME}_PREFIX}/$acl_libdirstem.
+AC_DEFUN([AC_LIB_LINKFLAGS],
+[
+  AC_REQUIRE([AC_LIB_PREPARE_PREFIX])
+  AC_REQUIRE([AC_LIB_RPATH])
+  pushdef([Name],[translit([$1],[./-], [___])])
+  pushdef([NAME],[translit([$1],[abcdefghijklmnopqrstuvwxyz./-],
+                                [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+  AC_CACHE_CHECK([how to link with lib[]$1], [ac_cv_lib[]Name[]_libs], [
+    AC_LIB_LINKFLAGS_BODY([$1], [$2])
+    ac_cv_lib[]Name[]_libs="$LIB[]NAME"
+    ac_cv_lib[]Name[]_ltlibs="$LTLIB[]NAME"
+    ac_cv_lib[]Name[]_cppflags="$INC[]NAME"
+    ac_cv_lib[]Name[]_prefix="$LIB[]NAME[]_PREFIX"
+  ])
+  LIB[]NAME="$ac_cv_lib[]Name[]_libs"
+  LTLIB[]NAME="$ac_cv_lib[]Name[]_ltlibs"
+  INC[]NAME="$ac_cv_lib[]Name[]_cppflags"
+  LIB[]NAME[]_PREFIX="$ac_cv_lib[]Name[]_prefix"
+  AC_LIB_APPENDTOVAR([CPPFLAGS], [$INC]NAME)
+  AC_SUBST([LIB]NAME)
+  AC_SUBST([LTLIB]NAME)
+  AC_SUBST([LIB]NAME[_PREFIX])
+  dnl Also set HAVE_LIB[]NAME so that AC_LIB_HAVE_LINKFLAGS can reuse the
+  dnl results of this search when this library appears as a dependency.
+  HAVE_LIB[]NAME=yes
+  popdef([NAME])
+  popdef([Name])
+])
+
+dnl AC_LIB_HAVE_LINKFLAGS(name, dependencies, includes, testcode, [missing-message])
+dnl searches for libname and the libraries corresponding to explicit and
+dnl implicit dependencies, together with the specified include files and
+dnl the ability to compile and link the specified testcode. The missing-message
+dnl defaults to 'no' and may contain additional hints for the user.
+dnl If found, it sets and AC_SUBSTs HAVE_LIB${NAME}=yes and the LIB${NAME}
+dnl and LTLIB${NAME} variables and augments the CPPFLAGS variable, and
+dnl #defines HAVE_LIB${NAME} to 1. Otherwise, it sets and AC_SUBSTs
+dnl HAVE_LIB${NAME}=no and LIB${NAME} and LTLIB${NAME} to empty.
+dnl Sets and AC_SUBSTs the LIB${NAME}_PREFIX variable to nonempty if libname
+dnl was found in ${LIB${NAME}_PREFIX}/$acl_libdirstem.
+AC_DEFUN([AC_LIB_HAVE_LINKFLAGS],
+[
+  AC_REQUIRE([AC_LIB_PREPARE_PREFIX])
+  AC_REQUIRE([AC_LIB_RPATH])
+  pushdef([Name],[translit([$1],[./-], [___])])
+  pushdef([NAME],[translit([$1],[abcdefghijklmnopqrstuvwxyz./-],
+                                [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+
+  dnl Search for lib[]Name and define LIB[]NAME, LTLIB[]NAME and INC[]NAME
+  dnl accordingly.
+  AC_LIB_LINKFLAGS_BODY([$1], [$2])
+
+  dnl Add $INC[]NAME to CPPFLAGS before performing the following checks,
+  dnl because if the user has installed lib[]Name and not disabled its use
+  dnl via --without-lib[]Name-prefix, he wants to use it.
+  ac_save_CPPFLAGS="$CPPFLAGS"
+  AC_LIB_APPENDTOVAR([CPPFLAGS], [$INC]NAME)
+
+  AC_CACHE_CHECK([for lib[]$1], [ac_cv_lib[]Name], [
+    ac_save_LIBS="$LIBS"
+    LIBS="$LIBS $LIB[]NAME"
+    AC_TRY_LINK([$3], [$4],
+      [ac_cv_lib[]Name=yes],
+      [ac_cv_lib[]Name='m4_if([$5], [], [no], [[$5]])'])
+    LIBS="$ac_save_LIBS"
+  ])
+  if test "$ac_cv_lib[]Name" = yes; then
+    HAVE_LIB[]NAME=yes
+    AC_DEFINE([HAVE_LIB]NAME, 1, [Define if you have the lib[]$1 library.])
+    AC_MSG_CHECKING([how to link with lib[]$1])
+    AC_MSG_RESULT([$LIB[]NAME])
+  else
+    HAVE_LIB[]NAME=no
+    dnl If $LIB[]NAME didn't lead to a usable library, we don't need
+    dnl $INC[]NAME either.
+    CPPFLAGS="$ac_save_CPPFLAGS"
+    LIB[]NAME=
+    LTLIB[]NAME=
+    LIB[]NAME[]_PREFIX=
+  fi
+  AC_SUBST([HAVE_LIB]NAME)
+  AC_SUBST([LIB]NAME)
+  AC_SUBST([LTLIB]NAME)
+  AC_SUBST([LIB]NAME[_PREFIX])
+  popdef([NAME])
+  popdef([Name])
+])
+
+dnl Determine the platform dependent parameters needed to use rpath:
+dnl   acl_libext,
+dnl   acl_shlibext,
+dnl   acl_hardcode_libdir_flag_spec,
+dnl   acl_hardcode_libdir_separator,
+dnl   acl_hardcode_direct,
+dnl   acl_hardcode_minus_L.
+AC_DEFUN([AC_LIB_RPATH],
+[
+  dnl Tell automake >= 1.10 to complain if config.rpath is missing.
+  m4_ifdef([AC_REQUIRE_AUX_FILE], [AC_REQUIRE_AUX_FILE([config.rpath])])
+  AC_REQUIRE([AC_PROG_CC])                dnl we use $CC, $GCC, $LDFLAGS
+  AC_REQUIRE([AC_LIB_PROG_LD])            dnl we use $LD, $with_gnu_ld
+  AC_REQUIRE([AC_CANONICAL_HOST])         dnl we use $host
+  AC_REQUIRE([AC_CONFIG_AUX_DIR_DEFAULT]) dnl we use $ac_aux_dir
+  AC_CACHE_CHECK([for shared library run path origin], [acl_cv_rpath], [
+    CC="$CC" GCC="$GCC" LDFLAGS="$LDFLAGS" LD="$LD" with_gnu_ld="$with_gnu_ld" \
+    ${CONFIG_SHELL-/bin/sh} "$ac_aux_dir/config.rpath" "$host" > conftest.sh
+    . ./conftest.sh
+    rm -f ./conftest.sh
+    acl_cv_rpath=done
+  ])
+  wl="$acl_cv_wl"
+  acl_libext="$acl_cv_libext"
+  acl_shlibext="$acl_cv_shlibext"
+  acl_libname_spec="$acl_cv_libname_spec"
+  acl_library_names_spec="$acl_cv_library_names_spec"
+  acl_hardcode_libdir_flag_spec="$acl_cv_hardcode_libdir_flag_spec"
+  acl_hardcode_libdir_separator="$acl_cv_hardcode_libdir_separator"
+  acl_hardcode_direct="$acl_cv_hardcode_direct"
+  acl_hardcode_minus_L="$acl_cv_hardcode_minus_L"
+  dnl Determine whether the user wants rpath handling at all.
+  AC_ARG_ENABLE([rpath],
+    [  --disable-rpath         do not hardcode runtime library paths],
+    :, enable_rpath=yes)
+])
+
+dnl AC_LIB_FROMPACKAGE(name, package)
+dnl declares that libname comes from the given package. The configure file
+dnl will then not have a --with-libname-prefix option but a
+dnl --with-package-prefix option. Several libraries can come from the same
+dnl package. This declaration must occur before an AC_LIB_LINKFLAGS or similar
+dnl macro call that searches for libname.
+AC_DEFUN([AC_LIB_FROMPACKAGE],
+[
+  pushdef([NAME],[translit([$1],[abcdefghijklmnopqrstuvwxyz./-],
+                                [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+  define([acl_frompackage_]NAME, [$2])
+  popdef([NAME])
+  pushdef([PACK],[$2])
+  pushdef([PACKUP],[translit(PACK,[abcdefghijklmnopqrstuvwxyz./-],
+                                  [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+  define([acl_libsinpackage_]PACKUP,
+    m4_ifdef([acl_libsinpackage_]PACKUP, [acl_libsinpackage_]PACKUP[[, ]],)[lib$1])
+  popdef([PACKUP])
+  popdef([PACK])
+])
+
+dnl AC_LIB_LINKFLAGS_BODY(name [, dependencies]) searches for libname and
+dnl the libraries corresponding to explicit and implicit dependencies.
+dnl Sets the LIB${NAME}, LTLIB${NAME} and INC${NAME} variables.
+dnl Also, sets the LIB${NAME}_PREFIX variable to nonempty if libname was found
+dnl in ${LIB${NAME}_PREFIX}/$acl_libdirstem.
+AC_DEFUN([AC_LIB_LINKFLAGS_BODY],
+[
+  AC_REQUIRE([AC_LIB_PREPARE_MULTILIB])
+  pushdef([NAME],[translit([$1],[abcdefghijklmnopqrstuvwxyz./-],
+                                [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+  pushdef([PACK],[m4_ifdef([acl_frompackage_]NAME, [acl_frompackage_]NAME, lib[$1])])
+  pushdef([PACKUP],[translit(PACK,[abcdefghijklmnopqrstuvwxyz./-],
+                                  [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+  pushdef([PACKLIBS],[m4_ifdef([acl_frompackage_]NAME, [acl_libsinpackage_]PACKUP, lib[$1])])
+  dnl Autoconf >= 2.61 supports dots in --with options.
+  pushdef([P_A_C_K],[m4_if(m4_version_compare(m4_defn([m4_PACKAGE_VERSION]),[2.61]),[-1],[translit(PACK,[.],[_])],PACK)])
+  dnl By default, look in $includedir and $libdir.
+  use_additional=yes
+  AC_LIB_WITH_FINAL_PREFIX([
+    eval additional_includedir=\"$includedir\"
+    eval additional_libdir=\"$libdir\"
+  ])
+  AC_ARG_WITH(P_A_C_K[-prefix],
+[[  --with-]]P_A_C_K[[-prefix[=DIR]  search for ]PACKLIBS[ in DIR/include and DIR/lib
+  --without-]]P_A_C_K[[-prefix     don't search for ]PACKLIBS[ in includedir and libdir]],
+[
+    if test "X$withval" = "Xno"; then
+      use_additional=no
+    else
+      if test "X$withval" = "X"; then
+        AC_LIB_WITH_FINAL_PREFIX([
+          eval additional_includedir=\"$includedir\"
+          eval additional_libdir=\"$libdir\"
+        ])
+      else
+        additional_includedir="$withval/include"
+        additional_libdir="$withval/$acl_libdirstem"
+        if test "$acl_libdirstem2" != "$acl_libdirstem" \
+           && ! test -d "$withval/$acl_libdirstem"; then
+          additional_libdir="$withval/$acl_libdirstem2"
+        fi
+      fi
+    fi
+])
+  dnl Search the library and its dependencies in $additional_libdir and
+  dnl $LDFLAGS. Using breadth-first-seach.
+  LIB[]NAME=
+  LTLIB[]NAME=
+  INC[]NAME=
+  LIB[]NAME[]_PREFIX=
+  rpathdirs=
+  ltrpathdirs=
+  names_already_handled=
+  names_next_round='$1 $2'
+  while test -n "$names_next_round"; do
+    names_this_round="$names_next_round"
+    names_next_round=
+    for name in $names_this_round; do
+      already_handled=
+      for n in $names_already_handled; do
+        if test "$n" = "$name"; then
+          already_handled=yes
+          break
+        fi
+      done
+      if test -z "$already_handled"; then
+        names_already_handled="$names_already_handled $name"
+        dnl See if it was already located by an earlier AC_LIB_LINKFLAGS
+        dnl or AC_LIB_HAVE_LINKFLAGS call.
+        uppername=`echo "$name" | sed -e 'y|abcdefghijklmnopqrstuvwxyz./-|ABCDEFGHIJKLMNOPQRSTUVWXYZ___|'`
+        eval value=\"\$HAVE_LIB$uppername\"
+        if test -n "$value"; then
+          if test "$value" = yes; then
+            eval value=\"\$LIB$uppername\"
+            test -z "$value" || LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$value"
+            eval value=\"\$LTLIB$uppername\"
+            test -z "$value" || LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }$value"
+          else
+            dnl An earlier call to AC_LIB_HAVE_LINKFLAGS has determined
+            dnl that this library doesn't exist. So just drop it.
+            :
+          fi
+        else
+          dnl Search the library lib$name in $additional_libdir and $LDFLAGS
+          dnl and the already constructed $LIBNAME/$LTLIBNAME.
+          found_dir=
+          found_la=
+          found_so=
+          found_a=
+          eval libname=\"$acl_libname_spec\"    # typically: libname=lib$name
+          if test -n "$acl_shlibext"; then
+            shrext=".$acl_shlibext"             # typically: shrext=.so
+          else
+            shrext=
+          fi
+          if test $use_additional = yes; then
+            dir="$additional_libdir"
+            dnl The same code as in the loop below:
+            dnl First look for a shared library.
+            if test -n "$acl_shlibext"; then
+              if test -f "$dir/$libname$shrext"; then
+                found_dir="$dir"
+                found_so="$dir/$libname$shrext"
+              else
+                if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then
+                  ver=`(cd "$dir" && \
+                        for f in "$libname$shrext".*; do echo "$f"; done \
+                        | sed -e "s,^$libname$shrext\\\\.,," \
+                        | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \
+                        | sed 1q ) 2>/dev/null`
+                  if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then
+                    found_dir="$dir"
+                    found_so="$dir/$libname$shrext.$ver"
+                  fi
+                else
+                  eval library_names=\"$acl_library_names_spec\"
+                  for f in $library_names; do
+                    if test -f "$dir/$f"; then
+                      found_dir="$dir"
+                      found_so="$dir/$f"
+                      break
+                    fi
+                  done
+                fi
+              fi
+            fi
+            dnl Then look for a static library.
+            if test "X$found_dir" = "X"; then
+              if test -f "$dir/$libname.$acl_libext"; then
+                found_dir="$dir"
+                found_a="$dir/$libname.$acl_libext"
+              fi
+            fi
+            if test "X$found_dir" != "X"; then
+              if test -f "$dir/$libname.la"; then
+                found_la="$dir/$libname.la"
+              fi
+            fi
+          fi
+          if test "X$found_dir" = "X"; then
+            for x in $LDFLAGS $LTLIB[]NAME; do
+              AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+              case "$x" in
+                -L*)
+                  dir=`echo "X$x" | sed -e 's/^X-L//'`
+                  dnl First look for a shared library.
+                  if test -n "$acl_shlibext"; then
+                    if test -f "$dir/$libname$shrext"; then
+                      found_dir="$dir"
+                      found_so="$dir/$libname$shrext"
+                    else
+                      if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then
+                        ver=`(cd "$dir" && \
+                              for f in "$libname$shrext".*; do echo "$f"; done \
+                              | sed -e "s,^$libname$shrext\\\\.,," \
+                              | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \
+                              | sed 1q ) 2>/dev/null`
+                        if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then
+                          found_dir="$dir"
+                          found_so="$dir/$libname$shrext.$ver"
+                        fi
+                      else
+                        eval library_names=\"$acl_library_names_spec\"
+                        for f in $library_names; do
+                          if test -f "$dir/$f"; then
+                            found_dir="$dir"
+                            found_so="$dir/$f"
+                            break
+                          fi
+                        done
+                      fi
+                    fi
+                  fi
+                  dnl Then look for a static library.
+                  if test "X$found_dir" = "X"; then
+                    if test -f "$dir/$libname.$acl_libext"; then
+                      found_dir="$dir"
+                      found_a="$dir/$libname.$acl_libext"
+                    fi
+                  fi
+                  if test "X$found_dir" != "X"; then
+                    if test -f "$dir/$libname.la"; then
+                      found_la="$dir/$libname.la"
+                    fi
+                  fi
+                  ;;
+              esac
+              if test "X$found_dir" != "X"; then
+                break
+              fi
+            done
+          fi
+          if test "X$found_dir" != "X"; then
+            dnl Found the library.
+            LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-L$found_dir -l$name"
+            if test "X$found_so" != "X"; then
+              dnl Linking with a shared library. We attempt to hardcode its
+              dnl directory into the executable's runpath, unless it's the
+              dnl standard /usr/lib.
+              if test "$enable_rpath" = no \
+                 || test "X$found_dir" = "X/usr/$acl_libdirstem" \
+                 || test "X$found_dir" = "X/usr/$acl_libdirstem2"; then
+                dnl No hardcoding is needed.
+                LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so"
+              else
+                dnl Use an explicit option to hardcode DIR into the resulting
+                dnl binary.
+                dnl Potentially add DIR to ltrpathdirs.
+                dnl The ltrpathdirs will be appended to $LTLIBNAME at the end.
+                haveit=
+                for x in $ltrpathdirs; do
+                  if test "X$x" = "X$found_dir"; then
+                    haveit=yes
+                    break
+                  fi
+                done
+                if test -z "$haveit"; then
+                  ltrpathdirs="$ltrpathdirs $found_dir"
+                fi
+                dnl The hardcoding into $LIBNAME is system dependent.
+                if test "$acl_hardcode_direct" = yes; then
+                  dnl Using DIR/libNAME.so during linking hardcodes DIR into the
+                  dnl resulting binary.
+                  LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so"
+                else
+                  if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then
+                    dnl Use an explicit option to hardcode DIR into the resulting
+                    dnl binary.
+                    LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so"
+                    dnl Potentially add DIR to rpathdirs.
+                    dnl The rpathdirs will be appended to $LIBNAME at the end.
+                    haveit=
+                    for x in $rpathdirs; do
+                      if test "X$x" = "X$found_dir"; then
+                        haveit=yes
+                        break
+                      fi
+                    done
+                    if test -z "$haveit"; then
+                      rpathdirs="$rpathdirs $found_dir"
+                    fi
+                  else
+                    dnl Rely on "-L$found_dir".
+                    dnl But don't add it if it's already contained in the LDFLAGS
+                    dnl or the already constructed $LIBNAME
+                    haveit=
+                    for x in $LDFLAGS $LIB[]NAME; do
+                      AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+                      if test "X$x" = "X-L$found_dir"; then
+                        haveit=yes
+                        break
+                      fi
+                    done
+                    if test -z "$haveit"; then
+                      LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$found_dir"
+                    fi
+                    if test "$acl_hardcode_minus_L" != no; then
+                      dnl FIXME: Not sure whether we should use
+                      dnl "-L$found_dir -l$name" or "-L$found_dir $found_so"
+                      dnl here.
+                      LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so"
+                    else
+                      dnl We cannot use $acl_hardcode_runpath_var and LD_RUN_PATH
+                      dnl here, because this doesn't fit in flags passed to the
+                      dnl compiler. So give up. No hardcoding. This affects only
+                      dnl very old systems.
+                      dnl FIXME: Not sure whether we should use
+                      dnl "-L$found_dir -l$name" or "-L$found_dir $found_so"
+                      dnl here.
+                      LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-l$name"
+                    fi
+                  fi
+                fi
+              fi
+            else
+              if test "X$found_a" != "X"; then
+                dnl Linking with a static library.
+                LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_a"
+              else
+                dnl We shouldn't come here, but anyway it's good to have a
+                dnl fallback.
+                LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$found_dir -l$name"
+              fi
+            fi
+            dnl Assume the include files are nearby.
+            additional_includedir=
+            case "$found_dir" in
+              */$acl_libdirstem | */$acl_libdirstem/)
+                basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem/"'*$,,'`
+                if test "$name" = '$1'; then
+                  LIB[]NAME[]_PREFIX="$basedir"
+                fi
+                additional_includedir="$basedir/include"
+                ;;
+              */$acl_libdirstem2 | */$acl_libdirstem2/)
+                basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem2/"'*$,,'`
+                if test "$name" = '$1'; then
+                  LIB[]NAME[]_PREFIX="$basedir"
+                fi
+                additional_includedir="$basedir/include"
+                ;;
+            esac
+            if test "X$additional_includedir" != "X"; then
+              dnl Potentially add $additional_includedir to $INCNAME.
+              dnl But don't add it
+              dnl   1. if it's the standard /usr/include,
+              dnl   2. if it's /usr/local/include and we are using GCC on Linux,
+              dnl   3. if it's already present in $CPPFLAGS or the already
+              dnl      constructed $INCNAME,
+              dnl   4. if it doesn't exist as a directory.
+              if test "X$additional_includedir" != "X/usr/include"; then
+                haveit=
+                if test "X$additional_includedir" = "X/usr/local/include"; then
+                  if test -n "$GCC"; then
+                    case $host_os in
+                      linux* | gnu* | k*bsd*-gnu) haveit=yes;;
+                    esac
+                  fi
+                fi
+                if test -z "$haveit"; then
+                  for x in $CPPFLAGS $INC[]NAME; do
+                    AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+                    if test "X$x" = "X-I$additional_includedir"; then
+                      haveit=yes
+                      break
+                    fi
+                  done
+                  if test -z "$haveit"; then
+                    if test -d "$additional_includedir"; then
+                      dnl Really add $additional_includedir to $INCNAME.
+                      INC[]NAME="${INC[]NAME}${INC[]NAME:+ }-I$additional_includedir"
+                    fi
+                  fi
+                fi
+              fi
+            fi
+            dnl Look for dependencies.
+            if test -n "$found_la"; then
+              dnl Read the .la file. It defines the variables
+              dnl dlname, library_names, old_library, dependency_libs, current,
+              dnl age, revision, installed, dlopen, dlpreopen, libdir.
+              save_libdir="$libdir"
+              case "$found_la" in
+                */* | *\\*) . "$found_la" ;;
+                *) . "./$found_la" ;;
+              esac
+              libdir="$save_libdir"
+              dnl We use only dependency_libs.
+              for dep in $dependency_libs; do
+                case "$dep" in
+                  -L*)
+                    additional_libdir=`echo "X$dep" | sed -e 's/^X-L//'`
+                    dnl Potentially add $additional_libdir to $LIBNAME and $LTLIBNAME.
+                    dnl But don't add it
+                    dnl   1. if it's the standard /usr/lib,
+                    dnl   2. if it's /usr/local/lib and we are using GCC on Linux,
+                    dnl   3. if it's already present in $LDFLAGS or the already
+                    dnl      constructed $LIBNAME,
+                    dnl   4. if it doesn't exist as a directory.
+                    if test "X$additional_libdir" != "X/usr/$acl_libdirstem" \
+                       && test "X$additional_libdir" != "X/usr/$acl_libdirstem2"; then
+                      haveit=
+                      if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem" \
+                         || test "X$additional_libdir" = "X/usr/local/$acl_libdirstem2"; then
+                        if test -n "$GCC"; then
+                          case $host_os in
+                            linux* | gnu* | k*bsd*-gnu) haveit=yes;;
+                          esac
+                        fi
+                      fi
+                      if test -z "$haveit"; then
+                        haveit=
+                        for x in $LDFLAGS $LIB[]NAME; do
+                          AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+                          if test "X$x" = "X-L$additional_libdir"; then
+                            haveit=yes
+                            break
+                          fi
+                        done
+                        if test -z "$haveit"; then
+                          if test -d "$additional_libdir"; then
+                            dnl Really add $additional_libdir to $LIBNAME.
+                            LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$additional_libdir"
+                          fi
+                        fi
+                        haveit=
+                        for x in $LDFLAGS $LTLIB[]NAME; do
+                          AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+                          if test "X$x" = "X-L$additional_libdir"; then
+                            haveit=yes
+                            break
+                          fi
+                        done
+                        if test -z "$haveit"; then
+                          if test -d "$additional_libdir"; then
+                            dnl Really add $additional_libdir to $LTLIBNAME.
+                            LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-L$additional_libdir"
+                          fi
+                        fi
+                      fi
+                    fi
+                    ;;
+                  -R*)
+                    dir=`echo "X$dep" | sed -e 's/^X-R//'`
+                    if test "$enable_rpath" != no; then
+                      dnl Potentially add DIR to rpathdirs.
+                      dnl The rpathdirs will be appended to $LIBNAME at the end.
+                      haveit=
+                      for x in $rpathdirs; do
+                        if test "X$x" = "X$dir"; then
+                          haveit=yes
+                          break
+                        fi
+                      done
+                      if test -z "$haveit"; then
+                        rpathdirs="$rpathdirs $dir"
+                      fi
+                      dnl Potentially add DIR to ltrpathdirs.
+                      dnl The ltrpathdirs will be appended to $LTLIBNAME at the end.
+                      haveit=
+                      for x in $ltrpathdirs; do
+                        if test "X$x" = "X$dir"; then
+                          haveit=yes
+                          break
+                        fi
+                      done
+                      if test -z "$haveit"; then
+                        ltrpathdirs="$ltrpathdirs $dir"
+                      fi
+                    fi
+                    ;;
+                  -l*)
+                    dnl Handle this in the next round.
+                    names_next_round="$names_next_round "`echo "X$dep" | sed -e 's/^X-l//'`
+                    ;;
+                  *.la)
+                    dnl Handle this in the next round. Throw away the .la's
+                    dnl directory; it is already contained in a preceding -L
+                    dnl option.
+                    names_next_round="$names_next_round "`echo "X$dep" | sed -e 's,^X.*/,,' -e 's,^lib,,' -e 's,\.la$,,'`
+                    ;;
+                  *)
+                    dnl Most likely an immediate library name.
+                    LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$dep"
+                    LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }$dep"
+                    ;;
+                esac
+              done
+            fi
+          else
+            dnl Didn't find the library; assume it is in the system directories
+            dnl known to the linker and runtime loader. (All the system
+            dnl directories known to the linker should also be known to the
+            dnl runtime loader, otherwise the system is severely misconfigured.)
+            LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-l$name"
+            LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-l$name"
+          fi
+        fi
+      fi
+    done
+  done
+  if test "X$rpathdirs" != "X"; then
+    if test -n "$acl_hardcode_libdir_separator"; then
+      dnl Weird platform: only the last -rpath option counts, the user must
+      dnl pass all path elements in one option. We can arrange that for a
+      dnl single library, but not when more than one $LIBNAMEs are used.
+      alldirs=
+      for found_dir in $rpathdirs; do
+        alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$found_dir"
+      done
+      dnl Note: acl_hardcode_libdir_flag_spec uses $libdir and $wl.
+      acl_save_libdir="$libdir"
+      libdir="$alldirs"
+      eval flag=\"$acl_hardcode_libdir_flag_spec\"
+      libdir="$acl_save_libdir"
+      LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$flag"
+    else
+      dnl The -rpath options are cumulative.
+      for found_dir in $rpathdirs; do
+        acl_save_libdir="$libdir"
+        libdir="$found_dir"
+        eval flag=\"$acl_hardcode_libdir_flag_spec\"
+        libdir="$acl_save_libdir"
+        LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$flag"
+      done
+    fi
+  fi
+  if test "X$ltrpathdirs" != "X"; then
+    dnl When using libtool, the option that works for both libraries and
+    dnl executables is -R. The -R options are cumulative.
+    for found_dir in $ltrpathdirs; do
+      LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-R$found_dir"
+    done
+  fi
+  popdef([P_A_C_K])
+  popdef([PACKLIBS])
+  popdef([PACKUP])
+  popdef([PACK])
+  popdef([NAME])
+])
+
+dnl AC_LIB_APPENDTOVAR(VAR, CONTENTS) appends the elements of CONTENTS to VAR,
+dnl unless already present in VAR.
+dnl Works only for CPPFLAGS, not for LIB* variables because that sometimes
+dnl contains two or three consecutive elements that belong together.
+AC_DEFUN([AC_LIB_APPENDTOVAR],
+[
+  for element in [$2]; do
+    haveit=
+    for x in $[$1]; do
+      AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+      if test "X$x" = "X$element"; then
+        haveit=yes
+        break
+      fi
+    done
+    if test -z "$haveit"; then
+      [$1]="${[$1]}${[$1]:+ }$element"
+    fi
+  done
+])
+
+dnl For those cases where a variable contains several -L and -l options
+dnl referring to unknown libraries and directories, this macro determines the
+dnl necessary additional linker options for the runtime path.
+dnl AC_LIB_LINKFLAGS_FROM_LIBS([LDADDVAR], [LIBSVALUE], [USE-LIBTOOL])
+dnl sets LDADDVAR to linker options needed together with LIBSVALUE.
+dnl If USE-LIBTOOL evaluates to non-empty, linking with libtool is assumed,
+dnl otherwise linking without libtool is assumed.
+AC_DEFUN([AC_LIB_LINKFLAGS_FROM_LIBS],
+[
+  AC_REQUIRE([AC_LIB_RPATH])
+  AC_REQUIRE([AC_LIB_PREPARE_MULTILIB])
+  $1=
+  if test "$enable_rpath" != no; then
+    if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then
+      dnl Use an explicit option to hardcode directories into the resulting
+      dnl binary.
+      rpathdirs=
+      next=
+      for opt in $2; do
+        if test -n "$next"; then
+          dir="$next"
+          dnl No need to hardcode the standard /usr/lib.
+          if test "X$dir" != "X/usr/$acl_libdirstem" \
+             && test "X$dir" != "X/usr/$acl_libdirstem2"; then
+            rpathdirs="$rpathdirs $dir"
+          fi
+          next=
+        else
+          case $opt in
+            -L) next=yes ;;
+            -L*) dir=`echo "X$opt" | sed -e 's,^X-L,,'`
+                 dnl No need to hardcode the standard /usr/lib.
+                 if test "X$dir" != "X/usr/$acl_libdirstem" \
+                    && test "X$dir" != "X/usr/$acl_libdirstem2"; then
+                   rpathdirs="$rpathdirs $dir"
+                 fi
+                 next= ;;
+            *) next= ;;
+          esac
+        fi
+      done
+      if test "X$rpathdirs" != "X"; then
+        if test -n ""$3""; then
+          dnl libtool is used for linking. Use -R options.
+          for dir in $rpathdirs; do
+            $1="${$1}${$1:+ }-R$dir"
+          done
+        else
+          dnl The linker is used for linking directly.
+          if test -n "$acl_hardcode_libdir_separator"; then
+            dnl Weird platform: only the last -rpath option counts, the user
+            dnl must pass all path elements in one option.
+            alldirs=
+            for dir in $rpathdirs; do
+              alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$dir"
+            done
+            acl_save_libdir="$libdir"
+            libdir="$alldirs"
+            eval flag=\"$acl_hardcode_libdir_flag_spec\"
+            libdir="$acl_save_libdir"
+            $1="$flag"
+          else
+            dnl The -rpath options are cumulative.
+            for dir in $rpathdirs; do
+              acl_save_libdir="$libdir"
+              libdir="$dir"
+              eval flag=\"$acl_hardcode_libdir_flag_spec\"
+              libdir="$acl_save_libdir"
+              $1="${$1}${$1:+ }$flag"
+            done
+          fi
+        fi
+      fi
+    fi
+  fi
+  AC_SUBST([$1])
+])
diff --git a/m4/lib-prefix.m4 b/m4/lib-prefix.m4
new file mode 100644
index 000000000..4b7ee3358
--- /dev/null
+++ b/m4/lib-prefix.m4
@@ -0,0 +1,224 @@
+# lib-prefix.m4 serial 7 (gettext-0.18)
+dnl Copyright (C) 2001-2005, 2008-2009 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.
+
+dnl From Bruno Haible.
+
+dnl AC_LIB_ARG_WITH is synonymous to AC_ARG_WITH in autoconf-2.13, and
+dnl similar to AC_ARG_WITH in autoconf 2.52...2.57 except that is doesn't
+dnl require excessive bracketing.
+ifdef([AC_HELP_STRING],
+[AC_DEFUN([AC_LIB_ARG_WITH], [AC_ARG_WITH([$1],[[$2]],[$3],[$4])])],
+[AC_DEFUN([AC_][LIB_ARG_WITH], [AC_ARG_WITH([$1],[$2],[$3],[$4])])])
+
+dnl AC_LIB_PREFIX adds to the CPPFLAGS and LDFLAGS the flags that are needed
+dnl to access previously installed libraries. The basic assumption is that
+dnl a user will want packages to use other packages he previously installed
+dnl with the same --prefix option.
+dnl This macro is not needed if only AC_LIB_LINKFLAGS is used to locate
+dnl libraries, but is otherwise very convenient.
+AC_DEFUN([AC_LIB_PREFIX],
+[
+  AC_BEFORE([$0], [AC_LIB_LINKFLAGS])
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST])
+  AC_REQUIRE([AC_LIB_PREPARE_MULTILIB])
+  AC_REQUIRE([AC_LIB_PREPARE_PREFIX])
+  dnl By default, look in $includedir and $libdir.
+  use_additional=yes
+  AC_LIB_WITH_FINAL_PREFIX([
+    eval additional_includedir=\"$includedir\"
+    eval additional_libdir=\"$libdir\"
+  ])
+  AC_LIB_ARG_WITH([lib-prefix],
+[  --with-lib-prefix[=DIR] search for libraries in DIR/include and DIR/lib
+  --without-lib-prefix    don't search for libraries in includedir and libdir],
+[
+    if test "X$withval" = "Xno"; then
+      use_additional=no
+    else
+      if test "X$withval" = "X"; then
+        AC_LIB_WITH_FINAL_PREFIX([
+          eval additional_includedir=\"$includedir\"
+          eval additional_libdir=\"$libdir\"
+        ])
+      else
+        additional_includedir="$withval/include"
+        additional_libdir="$withval/$acl_libdirstem"
+      fi
+    fi
+])
+  if test $use_additional = yes; then
+    dnl Potentially add $additional_includedir to $CPPFLAGS.
+    dnl But don't add it
+    dnl   1. if it's the standard /usr/include,
+    dnl   2. if it's already present in $CPPFLAGS,
+    dnl   3. if it's /usr/local/include and we are using GCC on Linux,
+    dnl   4. if it doesn't exist as a directory.
+    if test "X$additional_includedir" != "X/usr/include"; then
+      haveit=
+      for x in $CPPFLAGS; do
+        AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+        if test "X$x" = "X-I$additional_includedir"; then
+          haveit=yes
+          break
+        fi
+      done
+      if test -z "$haveit"; then
+        if test "X$additional_includedir" = "X/usr/local/include"; then
+          if test -n "$GCC"; then
+            case $host_os in
+              linux* | gnu* | k*bsd*-gnu) haveit=yes;;
+            esac
+          fi
+        fi
+        if test -z "$haveit"; then
+          if test -d "$additional_includedir"; then
+            dnl Really add $additional_includedir to $CPPFLAGS.
+            CPPFLAGS="${CPPFLAGS}${CPPFLAGS:+ }-I$additional_includedir"
+          fi
+        fi
+      fi
+    fi
+    dnl Potentially add $additional_libdir to $LDFLAGS.
+    dnl But don't add it
+    dnl   1. if it's the standard /usr/lib,
+    dnl   2. if it's already present in $LDFLAGS,
+    dnl   3. if it's /usr/local/lib and we are using GCC on Linux,
+    dnl   4. if it doesn't exist as a directory.
+    if test "X$additional_libdir" != "X/usr/$acl_libdirstem"; then
+      haveit=
+      for x in $LDFLAGS; do
+        AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+        if test "X$x" = "X-L$additional_libdir"; then
+          haveit=yes
+          break
+        fi
+      done
+      if test -z "$haveit"; then
+        if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem"; then
+          if test -n "$GCC"; then
+            case $host_os in
+              linux*) haveit=yes;;
+            esac
+          fi
+        fi
+        if test -z "$haveit"; then
+          if test -d "$additional_libdir"; then
+            dnl Really add $additional_libdir to $LDFLAGS.
+            LDFLAGS="${LDFLAGS}${LDFLAGS:+ }-L$additional_libdir"
+          fi
+        fi
+      fi
+    fi
+  fi
+])
+
+dnl AC_LIB_PREPARE_PREFIX creates variables acl_final_prefix,
+dnl acl_final_exec_prefix, containing the values to which $prefix and
+dnl $exec_prefix will expand at the end of the configure script.
+AC_DEFUN([AC_LIB_PREPARE_PREFIX],
+[
+  dnl Unfortunately, prefix and exec_prefix get only finally determined
+  dnl at the end of configure.
+  if test "X$prefix" = "XNONE"; then
+    acl_final_prefix="$ac_default_prefix"
+  else
+    acl_final_prefix="$prefix"
+  fi
+  if test "X$exec_prefix" = "XNONE"; then
+    acl_final_exec_prefix='${prefix}'
+  else
+    acl_final_exec_prefix="$exec_prefix"
+  fi
+  acl_save_prefix="$prefix"
+  prefix="$acl_final_prefix"
+  eval acl_final_exec_prefix=\"$acl_final_exec_prefix\"
+  prefix="$acl_save_prefix"
+])
+
+dnl AC_LIB_WITH_FINAL_PREFIX([statement]) evaluates statement, with the
+dnl variables prefix and exec_prefix bound to the values they will have
+dnl at the end of the configure script.
+AC_DEFUN([AC_LIB_WITH_FINAL_PREFIX],
+[
+  acl_save_prefix="$prefix"
+  prefix="$acl_final_prefix"
+  acl_save_exec_prefix="$exec_prefix"
+  exec_prefix="$acl_final_exec_prefix"
+  $1
+  exec_prefix="$acl_save_exec_prefix"
+  prefix="$acl_save_prefix"
+])
+
+dnl AC_LIB_PREPARE_MULTILIB creates
+dnl - a variable acl_libdirstem, containing the basename of the libdir, either
+dnl   "lib" or "lib64" or "lib/64",
+dnl - a variable acl_libdirstem2, as a secondary possible value for
+dnl   acl_libdirstem, either the same as acl_libdirstem or "lib/sparcv9" or
+dnl   "lib/amd64".
+AC_DEFUN([AC_LIB_PREPARE_MULTILIB],
+[
+  dnl There is no formal standard regarding lib and lib64.
+  dnl On glibc systems, the current practice is that on a system supporting
+  dnl 32-bit and 64-bit instruction sets or ABIs, 64-bit libraries go under
+  dnl $prefix/lib64 and 32-bit libraries go under $prefix/lib. We determine
+  dnl the compiler's default mode by looking at the compiler's library search
+  dnl path. If at least one of its elements ends in /lib64 or points to a
+  dnl directory whose absolute pathname ends in /lib64, we assume a 64-bit ABI.
+  dnl Otherwise we use the default, namely "lib".
+  dnl On Solaris systems, the current practice is that on a system supporting
+  dnl 32-bit and 64-bit instruction sets or ABIs, 64-bit libraries go under
+  dnl $prefix/lib/64 (which is a symlink to either $prefix/lib/sparcv9 or
+  dnl $prefix/lib/amd64) and 32-bit libraries go under $prefix/lib.
+  AC_REQUIRE([AC_CANONICAL_HOST])
+  acl_libdirstem=lib
+  acl_libdirstem2=
+  case "$host_os" in
+    solaris*)
+      dnl See Solaris 10 Software Developer Collection > Solaris 64-bit Developer's Guide > The Development Environment
+      dnl <http://docs.sun.com/app/docs/doc/816-5138/dev-env?l=en&a=view>.
+      dnl "Portable Makefiles should refer to any library directories using the 64 symbolic link."
+      dnl But we want to recognize the sparcv9 or amd64 subdirectory also if the
+      dnl symlink is missing, so we set acl_libdirstem2 too.
+      AC_CACHE_CHECK([for 64-bit host], [gl_cv_solaris_64bit],
+        [AC_EGREP_CPP([sixtyfour bits], [
+#ifdef _LP64
+sixtyfour bits
+#endif
+           ], [gl_cv_solaris_64bit=yes], [gl_cv_solaris_64bit=no])
+        ])
+      if test $gl_cv_solaris_64bit = yes; then
+        acl_libdirstem=lib/64
+        case "$host_cpu" in
+          sparc*)        acl_libdirstem2=lib/sparcv9 ;;
+          i*86 | x86_64) acl_libdirstem2=lib/amd64 ;;
+        esac
+      fi
+      ;;
+    *)
+      searchpath=`(LC_ALL=C $CC -print-search-dirs) 2>/dev/null | sed -n -e 's,^libraries: ,,p' | sed -e 's,^=,,'`
+      if test -n "$searchpath"; then
+        acl_save_IFS="${IFS= 	}"; IFS=":"
+        for searchdir in $searchpath; do
+          if test -d "$searchdir"; then
+            case "$searchdir" in
+              */lib64/ | */lib64 ) acl_libdirstem=lib64 ;;
+              */../ | */.. )
+                # Better ignore directories of this form. They are misleading.
+                ;;
+              *) searchdir=`cd "$searchdir" && pwd`
+                 case "$searchdir" in
+                   */lib64 ) acl_libdirstem=lib64 ;;
+                 esac ;;
+            esac
+          fi
+        done
+        IFS="$acl_save_IFS"
+      fi
+      ;;
+  esac
+  test -n "$acl_libdirstem2" || acl_libdirstem2="$acl_libdirstem"
+])
diff --git a/m4/libunistring.m4 b/m4/libunistring.m4
new file mode 100644
index 000000000..52ff06b61
--- /dev/null
+++ b/m4/libunistring.m4
@@ -0,0 +1,37 @@
+# libunistring.m4 serial 1
+dnl Copyright (C) 2009 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.
+
+dnl gl_LIBUNISTRING
+dnl Searches for an installed libunistring.
+dnl If found, it sets and AC_SUBSTs HAVE_LIBUNISTRING=yes and the LIBUNISTRING
+dnl and LTLIBUNISTRING variables and augments the CPPFLAGS variable, and
+dnl #defines HAVE_LIBUNISTRING to 1. Otherwise, it sets and AC_SUBSTs
+dnl HAVE_LIBUNISTRING=no and LIBUNINSTRING and LTLIBUNISTRING to empty.
+
+AC_DEFUN([gl_LIBUNISTRING],
+[
+  dnl First, try to link without -liconv. libunistring often depends on
+  dnl libiconv, but we don't know (and often don't need to know) where
+  dnl libiconv is installed.
+  AC_LIB_HAVE_LINKFLAGS([unistring], [],
+    [#include <uniconv.h>], [u8_strconv_from_locale((char*)0);],
+    [no, consider installing GNU libunistring])
+  if test "$ac_cv_libunistring" != yes; then
+    dnl Second try, with -liconv.
+    AC_REQUIRE([AM_ICONV])
+    if test -n "$LIBICONV"; then
+      glus_save_LIBS="$LIBS"
+      LIBS="$LIBS $LIBICONV"
+      AC_LIB_HAVE_LINKFLAGS([unistring], [],
+        [#include <uniconv.h>], [u8_strconv_from_locale((char*)0);],
+        [no, consider installing GNU libunistring])
+      if test -n "$LIBUNISTRING"; then
+        LIBUNISTRING="$LIBUNISTRING $LIBICONV"
+      fi
+      LIBS="$glus_save_LIBS"
+    fi
+  fi
+])
diff --git a/m4/string_h.m4 b/m4/string_h.m4
new file mode 100644
index 000000000..2d5553c37
--- /dev/null
+++ b/m4/string_h.m4
@@ -0,0 +1,92 @@
+# Configure a GNU-like replacement for <string.h>.
+
+# Copyright (C) 2007, 2008 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.
+
+# serial 6
+
+# Written by Paul Eggert.
+
+AC_DEFUN([gl_HEADER_STRING_H],
+[
+  dnl Use AC_REQUIRE here, so that the default behavior below is expanded
+  dnl once only, before all statements that occur in other macros.
+  AC_REQUIRE([gl_HEADER_STRING_H_BODY])
+])
+
+AC_DEFUN([gl_HEADER_STRING_H_BODY],
+[
+  AC_REQUIRE([AC_C_RESTRICT])
+  AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
+  gl_CHECK_NEXT_HEADERS([string.h])
+])
+
+AC_DEFUN([gl_STRING_MODULE_INDICATOR],
+[
+  dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+  AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
+  GNULIB_[]m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=1
+])
+
+AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
+[
+  GNULIB_MEMMEM=0;      AC_SUBST([GNULIB_MEMMEM])
+  GNULIB_MEMPCPY=0;     AC_SUBST([GNULIB_MEMPCPY])
+  GNULIB_MEMRCHR=0;     AC_SUBST([GNULIB_MEMRCHR])
+  GNULIB_RAWMEMCHR=0;   AC_SUBST([GNULIB_RAWMEMCHR])
+  GNULIB_STPCPY=0;      AC_SUBST([GNULIB_STPCPY])
+  GNULIB_STPNCPY=0;     AC_SUBST([GNULIB_STPNCPY])
+  GNULIB_STRCHRNUL=0;   AC_SUBST([GNULIB_STRCHRNUL])
+  GNULIB_STRDUP=0;      AC_SUBST([GNULIB_STRDUP])
+  GNULIB_STRNDUP=0;     AC_SUBST([GNULIB_STRNDUP])
+  GNULIB_STRNLEN=0;     AC_SUBST([GNULIB_STRNLEN])
+  GNULIB_STRPBRK=0;     AC_SUBST([GNULIB_STRPBRK])
+  GNULIB_STRSEP=0;      AC_SUBST([GNULIB_STRSEP])
+  GNULIB_STRSTR=0;      AC_SUBST([GNULIB_STRSTR])
+  GNULIB_STRCASESTR=0;  AC_SUBST([GNULIB_STRCASESTR])
+  GNULIB_STRTOK_R=0;    AC_SUBST([GNULIB_STRTOK_R])
+  GNULIB_MBSLEN=0;      AC_SUBST([GNULIB_MBSLEN])
+  GNULIB_MBSNLEN=0;     AC_SUBST([GNULIB_MBSNLEN])
+  GNULIB_MBSCHR=0;      AC_SUBST([GNULIB_MBSCHR])
+  GNULIB_MBSRCHR=0;     AC_SUBST([GNULIB_MBSRCHR])
+  GNULIB_MBSSTR=0;      AC_SUBST([GNULIB_MBSSTR])
+  GNULIB_MBSCASECMP=0;  AC_SUBST([GNULIB_MBSCASECMP])
+  GNULIB_MBSNCASECMP=0; AC_SUBST([GNULIB_MBSNCASECMP])
+  GNULIB_MBSPCASECMP=0; AC_SUBST([GNULIB_MBSPCASECMP])
+  GNULIB_MBSCASESTR=0;  AC_SUBST([GNULIB_MBSCASESTR])
+  GNULIB_MBSCSPN=0;     AC_SUBST([GNULIB_MBSCSPN])
+  GNULIB_MBSPBRK=0;     AC_SUBST([GNULIB_MBSPBRK])
+  GNULIB_MBSSPN=0;      AC_SUBST([GNULIB_MBSSPN])
+  GNULIB_MBSSEP=0;      AC_SUBST([GNULIB_MBSSEP])
+  GNULIB_MBSTOK_R=0;    AC_SUBST([GNULIB_MBSTOK_R])
+  GNULIB_STRERROR=0;    AC_SUBST([GNULIB_STRERROR])
+  GNULIB_STRSIGNAL=0;   AC_SUBST([GNULIB_STRSIGNAL])
+  GNULIB_STRVERSCMP=0;   AC_SUBST([GNULIB_STRVERSCMP])
+  dnl Assume proper GNU behavior unless another module says otherwise.
+  HAVE_DECL_MEMMEM=1;		AC_SUBST([HAVE_DECL_MEMMEM])
+  HAVE_MEMPCPY=1;		AC_SUBST([HAVE_MEMPCPY])
+  HAVE_DECL_MEMRCHR=1;		AC_SUBST([HAVE_DECL_MEMRCHR])
+  HAVE_RAWMEMCHR=1;		AC_SUBST([HAVE_RAWMEMCHR])
+  HAVE_STPCPY=1;		AC_SUBST([HAVE_STPCPY])
+  HAVE_STPNCPY=1;		AC_SUBST([HAVE_STPNCPY])
+  HAVE_STRCHRNUL=1;		AC_SUBST([HAVE_STRCHRNUL])
+  HAVE_DECL_STRDUP=1;		AC_SUBST([HAVE_DECL_STRDUP])
+  HAVE_STRNDUP=1;		AC_SUBST([HAVE_STRNDUP])
+  HAVE_DECL_STRNDUP=1;		AC_SUBST([HAVE_DECL_STRNDUP])
+  HAVE_DECL_STRNLEN=1;		AC_SUBST([HAVE_DECL_STRNLEN])
+  HAVE_STRPBRK=1;		AC_SUBST([HAVE_STRPBRK])
+  HAVE_STRSEP=1;		AC_SUBST([HAVE_STRSEP])
+  HAVE_STRCASESTR=1;		AC_SUBST([HAVE_STRCASESTR])
+  HAVE_DECL_STRTOK_R=1;		AC_SUBST([HAVE_DECL_STRTOK_R])
+  HAVE_DECL_STRERROR=1;		AC_SUBST([HAVE_DECL_STRERROR])
+  HAVE_DECL_STRSIGNAL=1;	AC_SUBST([HAVE_DECL_STRSIGNAL])
+  HAVE_STRVERSCMP=1;		AC_SUBST([HAVE_STRVERSCMP])
+  REPLACE_MEMMEM=0;		AC_SUBST([REPLACE_MEMMEM])
+  REPLACE_STRDUP=0;		AC_SUBST([REPLACE_STRDUP])
+  REPLACE_STRSTR=0;		AC_SUBST([REPLACE_STRSTR])
+  REPLACE_STRCASESTR=0;		AC_SUBST([REPLACE_STRCASESTR])
+  REPLACE_STRERROR=0;		AC_SUBST([REPLACE_STRERROR])
+  REPLACE_STRSIGNAL=0;		AC_SUBST([REPLACE_STRSIGNAL])
+])
diff --git a/meta/uninstalled-env.in b/meta/uninstalled-env.in
index d5c7949f5..b15237c4b 100644
--- a/meta/uninstalled-env.in
+++ b/meta/uninstalled-env.in
@@ -66,9 +66,26 @@ else
 fi
 export GUILE_LOAD_PATH
 
+if [ x"$GUILE_LOAD_COMPILED_PATH" = x ]
+then
+  GUILE_LOAD_COMPILED_PATH="${top_builddir}/guile-readline:${top_builddir}:${top_builddir}/module"
+else
+  for d in "${top_builddir}" "${top_builddir}/guile-readline" \
+           "${top_builddir}/module"
+  do
+    # This hair prevents double inclusion.
+    # The ":" prevents prefix aliasing.
+    case x"$GUILE_LOAD_COMPILED_PATH" in
+      x*${d}:*) ;;
+      *) GUILE_LOAD_COMPILED_PATH="${d}:$GUILE_LOAD_COMPILED_PATH" ;;
+    esac
+  done
+fi
+export GUILE_LOAD_COMPILED_PATH
+
 # Don't look in installed dirs for guile modules
-if ( env | grep -v -q -E '^GUILE_SYSTEM_PATH=' ); then
-  export GUILE_SYSTEM_PATH=
+if ( env | grep -v -q -E '^GUILE_SYSTEM_COMPILED_PATH=' ); then
+  export GUILE_SYSTEM_COMPILED_PATH=
 fi
 
 # handle LTDL_LIBRARY_PATH (no clobber)
diff --git a/module/Makefile.am b/module/Makefile.am
index 41c6b77f4..244746481 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -47,6 +47,7 @@ SOURCES =								\
 									\
   $(ICE_9_SOURCES)							\
   $(SRFI_SOURCES)							\
+  $(RNRS_SOURCES)							\
   $(OOP_SOURCES)							\
   $(SYSTEM_SOURCES)                                                     \
   $(ECMASCRIPT_LANG_SOURCES)						\
@@ -216,7 +217,12 @@ SRFI_SOURCES = \
   srfi/srfi-39.scm \
   srfi/srfi-60.scm \
   srfi/srfi-69.scm \
-  srfi/srfi-88.scm
+  srfi/srfi-88.scm \
+  srfi/srfi-98.scm
+
+RNRS_SOURCES =					\
+  rnrs/bytevector.scm				\
+  rnrs/io/ports.scm
 
 EXTRA_DIST += scripts/ChangeLog-2008
 EXTRA_DIST += scripts/README
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 26ce1a905..bb66ccfb6 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -611,12 +611,10 @@
     (primitive-load-path "ice-9/networking"))
 
 ;; For reference, Emacs file-exists-p uses stat in this same way.
-;; ENHANCE-ME: Catching an exception from stat is a bit wasteful, do this in
-;; C where all that's needed is to inspect the return from stat().
 (define file-exists?
   (if (provided? 'posix)
       (lambda (str)
-	(->bool (false-if-exception (stat str))))
+	(->bool (stat str #f)))
       (lambda (str)
 	(let ((port (catch 'system-error (lambda () (open-file str OPEN_READ))
 			   (lambda args #f))))
@@ -961,9 +959,6 @@
 ;;; Reader code for various "#c" forms.
 ;;;
 
-(read-hash-extend #\' (lambda (c port)
-			(read port)))
-
 (define read-eval? (make-fluid))
 (fluid-set! read-eval? #f)
 (read-hash-extend #\.
@@ -2275,27 +2270,15 @@ module '(ice-9 q) '(make-q q-length))}."
     (resolve-module dir-hint-module-name #f)
     (and (not (autoload-done-or-in-progress? dir-hint name))
 	 (let ((didit #f))
-	   (define (load-file proc file)
-	     (save-module-excursion (lambda () (proc file)))
-	     (set! didit #t))
 	   (dynamic-wind
 	    (lambda () (autoload-in-progress! dir-hint name))
 	    (lambda ()
-	      (let ((file (in-vicinity dir-hint name)))
-                (let ((compiled (and load-compiled
-                                     (%search-load-path
-                                      (string-append file ".go"))))
-                      (source (%search-load-path file)))
-                  (cond ((and source
-                              (or (not compiled)
-                                  (< (stat:mtime (stat compiled))
-                                     (stat:mtime (stat source)))))
-                         (if compiled
-                             (warn "source file" source "newer than" compiled))
-                         (with-fluid* current-reader #f
-                           (lambda () (load-file primitive-load source))))
-                        (compiled
-                         (load-file load-compiled compiled))))))
+	      (with-fluid* current-reader #f
+                (lambda ()
+                  (save-module-excursion
+                   (lambda () 
+                     (primitive-load-path (in-vicinity dir-hint name) #f)
+                     (set! didit #t))))))
 	    (lambda () (set-autoloaded! dir-hint name didit)))
 	   didit))))
 
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index f33f49286..0043cbbd3 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,13 +1,13 @@
 (eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
 (if #f #f)
-(letrec ((and-map*151 (lambda (f191 first190 . rest189) (let ((t192 (null? first190))) (if t192 t192 (if (null? rest189) (letrec ((andmap193 (lambda (first194) (let ((x195 (car first194)) (first196 (cdr first194))) (if (null? first196) (f191 x195) (if (f191 x195) (andmap193 first196) #f)))))) (andmap193 first190)) (letrec ((andmap197 (lambda (first198 rest199) (let ((x200 (car first198)) (xr201 (map car rest199)) (first202 (cdr first198)) (rest203 (map cdr rest199))) (if (null? first202) (apply f191 (cons x200 xr201)) (if (apply f191 (cons x200 xr201)) (andmap197 first202 rest203) #f)))))) (andmap197 first190 rest189)))))))) (letrec ((lambda-var-list296 (lambda (vars420) (letrec ((lvl421 (lambda (vars422 ls423 w424) (if (pair? vars422) (lvl421 (cdr vars422) (cons (wrap276 (car vars422) w424 #f) ls423) w424) (if (id?248 vars422) (cons (wrap276 vars422 w424 #f) ls423) (if (null? vars422) ls423 (if (syntax-object?232 vars422) (lvl421 (syntax-object-expression233 vars422) ls423 (join-wraps267 w424 (syntax-object-wrap234 vars422))) (cons vars422 ls423)))))))) (lvl421 vars420 (quote ()) (quote (())))))) (gen-var295 (lambda (id425) (let ((id426 (if (syntax-object?232 id425) (syntax-object-expression233 id425) id425))) (gensym (symbol->string id426))))) (strip294 (lambda (x427 w428) (if (memq (quote top) (wrap-marks251 w428)) x427 (letrec ((f429 (lambda (x430) (if (syntax-object?232 x430) (strip294 (syntax-object-expression233 x430) (syntax-object-wrap234 x430)) (if (pair? x430) (let ((a431 (f429 (car x430))) (d432 (f429 (cdr x430)))) (if (if (eq? a431 (car x430)) (eq? d432 (cdr x430)) #f) x430 (cons a431 d432))) (if (vector? x430) (let ((old433 (vector->list x430))) (let ((new434 (map f429 old433))) (if (and-map*151 eq? old433 new434) x430 (list->vector new434)))) x430)))))) (f429 x427))))) (ellipsis?293 (lambda (x435) (if (nonsymbol-id?247 x435) (free-id=?271 x435 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void292 (lambda () (build-void214 #f))) (eval-local-transformer291 (lambda (expanded436 mod437) (let ((p438 (local-eval-hook211 expanded436 mod437))) (if (procedure? p438) p438 (syntax-violation #f "nonprocedure transformer" p438))))) (chi-local-syntax290 (lambda (rec?439 e440 r441 w442 s443 mod444 k445) ((lambda (tmp446) ((lambda (tmp447) (if tmp447 (apply (lambda (_448 id449 val450 e1451 e2452) (let ((ids453 id449)) (if (not (valid-bound-ids?273 ids453)) (syntax-violation #f "duplicate bound keyword" e440) (let ((labels455 (gen-labels254 ids453))) (let ((new-w456 (make-binding-wrap265 ids453 labels455 w442))) (k445 (cons e1451 e2452) (extend-env242 labels455 (let ((w458 (if rec?439 new-w456 w442)) (trans-r459 (macros-only-env244 r441))) (map (lambda (x460) (cons (quote macro) (eval-local-transformer291 (chi284 x460 trans-r459 w458 mod444) mod444))) val450)) r441) new-w456 s443 mod444)))))) tmp447) ((lambda (_462) (syntax-violation #f "bad local syntax definition" (source-wrap277 e440 w442 s443 mod444))) tmp446))) ($sc-dispatch tmp446 (quote (any #(each (any any)) any . each-any))))) e440))) (chi-lambda-clause289 (lambda (e463 docstring464 c465 r466 w467 mod468 k469) ((lambda (tmp470) ((lambda (tmp471) (if (if tmp471 (apply (lambda (args472 doc473 e1474 e2475) (if (string? (syntax->datum doc473)) (not docstring464) #f)) tmp471) #f) (apply (lambda (args476 doc477 e1478 e2479) (chi-lambda-clause289 e463 doc477 (cons args476 (cons e1478 e2479)) r466 w467 mod468 k469)) tmp471) ((lambda (tmp481) (if tmp481 (apply (lambda (id482 e1483 e2484) (let ((ids485 id482)) (if (not (valid-bound-ids?273 ids485)) (syntax-violation (quote lambda) "invalid parameter list" e463) (let ((labels487 (gen-labels254 ids485)) (new-vars488 (map gen-var295 ids485))) (k469 (map syntax->datum ids485) new-vars488 (if docstring464 (syntax->datum docstring464) #f) (chi-body288 (cons e1483 e2484) e463 (extend-var-env243 labels487 new-vars488 r466) (make-binding-wrap265 ids485 labels487 w467) mod468)))))) tmp481) ((lambda (tmp490) (if tmp490 (apply (lambda (ids491 e1492 e2493) (let ((old-ids494 (lambda-var-list296 ids491))) (if (not (valid-bound-ids?273 old-ids494)) (syntax-violation (quote lambda) "invalid parameter list" e463) (let ((labels495 (gen-labels254 old-ids494)) (new-vars496 (map gen-var295 old-ids494))) (k469 (letrec ((f497 (lambda (ls1498 ls2499) (if (null? ls1498) (syntax->datum ls2499) (f497 (cdr ls1498) (cons (syntax->datum (car ls1498)) ls2499)))))) (f497 (cdr old-ids494) (car old-ids494))) (letrec ((f500 (lambda (ls1501 ls2502) (if (null? ls1501) ls2502 (f500 (cdr ls1501) (cons (car ls1501) ls2502)))))) (f500 (cdr new-vars496) (car new-vars496))) (if docstring464 (syntax->datum docstring464) #f) (chi-body288 (cons e1492 e2493) e463 (extend-var-env243 labels495 new-vars496 r466) (make-binding-wrap265 old-ids494 labels495 w467) mod468)))))) tmp490) ((lambda (_504) (syntax-violation (quote lambda) "bad lambda" e463)) tmp470))) ($sc-dispatch tmp470 (quote (any any . each-any)))))) ($sc-dispatch tmp470 (quote (each-any any . each-any)))))) ($sc-dispatch tmp470 (quote (any any any . each-any))))) c465))) (chi-body288 (lambda (body505 outer-form506 r507 w508 mod509) (let ((r510 (cons (quote ("placeholder" placeholder)) r507))) (let ((ribcage511 (make-ribcage255 (quote ()) (quote ()) (quote ())))) (let ((w512 (make-wrap250 (wrap-marks251 w508) (cons ribcage511 (wrap-subst252 w508))))) (letrec ((parse513 (lambda (body514 ids515 labels516 var-ids517 vars518 vals519 bindings520) (if (null? body514) (syntax-violation #f "no expressions in body" outer-form506) (let ((e522 (cdar body514)) (er523 (caar body514))) (call-with-values (lambda () (syntax-type282 e522 er523 (quote (())) (source-annotation239 er523) ribcage511 mod509)) (lambda (type524 value525 e526 w527 s528 mod529) (if (memv type524 (quote (define-form))) (let ((id530 (wrap276 value525 w527 mod529)) (label531 (gen-label253))) (let ((var532 (gen-var295 id530))) (begin (extend-ribcage!264 ribcage511 id530 label531) (parse513 (cdr body514) (cons id530 ids515) (cons label531 labels516) (cons id530 var-ids517) (cons var532 vars518) (cons (cons er523 (wrap276 e526 w527 mod529)) vals519) (cons (cons (quote lexical) var532) bindings520))))) (if (memv type524 (quote (define-syntax-form))) (let ((id533 (wrap276 value525 w527 mod529)) (label534 (gen-label253))) (begin (extend-ribcage!264 ribcage511 id533 label534) (parse513 (cdr body514) (cons id533 ids515) (cons label534 labels516) var-ids517 vars518 vals519 (cons (cons (quote macro) (cons er523 (wrap276 e526 w527 mod529))) bindings520)))) (if (memv type524 (quote (begin-form))) ((lambda (tmp535) ((lambda (tmp536) (if tmp536 (apply (lambda (_537 e1538) (parse513 (letrec ((f539 (lambda (forms540) (if (null? forms540) (cdr body514) (cons (cons er523 (wrap276 (car forms540) w527 mod529)) (f539 (cdr forms540))))))) (f539 e1538)) ids515 labels516 var-ids517 vars518 vals519 bindings520)) tmp536) (syntax-violation #f "source expression failed to match any pattern" tmp535))) ($sc-dispatch tmp535 (quote (any . each-any))))) e526) (if (memv type524 (quote (local-syntax-form))) (chi-local-syntax290 value525 e526 er523 w527 s528 mod529 (lambda (forms542 er543 w544 s545 mod546) (parse513 (letrec ((f547 (lambda (forms548) (if (null? forms548) (cdr body514) (cons (cons er543 (wrap276 (car forms548) w544 mod546)) (f547 (cdr forms548))))))) (f547 forms542)) ids515 labels516 var-ids517 vars518 vals519 bindings520))) (if (null? ids515) (build-sequence227 #f (map (lambda (x549) (chi284 (cdr x549) (car x549) (quote (())) mod529)) (cons (cons er523 (source-wrap277 e526 w527 s528 mod529)) (cdr body514)))) (begin (if (not (valid-bound-ids?273 ids515)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form506)) (letrec ((loop550 (lambda (bs551 er-cache552 r-cache553) (if (not (null? bs551)) (let ((b554 (car bs551))) (if (eq? (car b554) (quote macro)) (let ((er555 (cadr b554))) (let ((r-cache556 (if (eq? er555 er-cache552) r-cache553 (macros-only-env244 er555)))) (begin (set-cdr! b554 (eval-local-transformer291 (chi284 (cddr b554) r-cache556 (quote (())) mod529) mod529)) (loop550 (cdr bs551) er555 r-cache556)))) (loop550 (cdr bs551) er-cache552 r-cache553))))))) (loop550 bindings520 #f #f)) (set-cdr! r510 (extend-env242 labels516 bindings520 (cdr r510))) (build-letrec230 #f (map syntax->datum var-ids517) vars518 (map (lambda (x557) (chi284 (cdr x557) (car x557) (quote (())) mod529)) vals519) (build-sequence227 #f (map (lambda (x558) (chi284 (cdr x558) (car x558) (quote (())) mod529)) (cons (cons er523 (source-wrap277 e526 w527 s528 mod529)) (cdr body514)))))))))))))))))) (parse513 (map (lambda (x521) (cons r510 (wrap276 x521 w512 mod509))) body505) (quote ()) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro287 (lambda (p559 e560 r561 w562 rib563 mod564) (letrec ((rebuild-macro-output565 (lambda (x566 m567) (if (pair? x566) (cons (rebuild-macro-output565 (car x566) m567) (rebuild-macro-output565 (cdr x566) m567)) (if (syntax-object?232 x566) (let ((w568 (syntax-object-wrap234 x566))) (let ((ms569 (wrap-marks251 w568)) (s570 (wrap-subst252 w568))) (if (if (pair? ms569) (eq? (car ms569) #f) #f) (make-syntax-object231 (syntax-object-expression233 x566) (make-wrap250 (cdr ms569) (if rib563 (cons rib563 (cdr s570)) (cdr s570))) (syntax-object-module235 x566)) (make-syntax-object231 (syntax-object-expression233 x566) (make-wrap250 (cons m567 ms569) (if rib563 (cons rib563 (cons (quote shift) s570)) (cons (quote shift) s570))) (let ((pmod571 (procedure-module p559))) (if pmod571 (cons (quote hygiene) (module-name pmod571)) (quote (hygiene guile)))))))) (if (vector? x566) (let ((n572 (vector-length x566))) (let ((v573 (make-vector n572))) (letrec ((loop574 (lambda (i575) (if (fx=208 i575 n572) (begin (if #f #f) v573) (begin (vector-set! v573 i575 (rebuild-macro-output565 (vector-ref x566 i575) m567)) (loop574 (fx+206 i575 1))))))) (loop574 0)))) (if (symbol? x566) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap277 e560 w562 s mod564) x566) x566))))))) (rebuild-macro-output565 (p559 (wrap276 e560 (anti-mark263 w562) mod564)) (string #\m))))) (chi-application286 (lambda (x576 e577 r578 w579 s580 mod581) ((lambda (tmp582) ((lambda (tmp583) (if tmp583 (apply (lambda (e0584 e1585) (build-application215 s580 x576 (map (lambda (e586) (chi284 e586 r578 w579 mod581)) e1585))) tmp583) (syntax-violation #f "source expression failed to match any pattern" tmp582))) ($sc-dispatch tmp582 (quote (any . each-any))))) e577))) (chi-expr285 (lambda (type588 value589 e590 r591 w592 s593 mod594) (if (memv type588 (quote (lexical))) (build-lexical-reference217 (quote value) s593 e590 value589) (if (memv type588 (quote (core external-macro))) (value589 e590 r591 w592 s593 mod594) (if (memv type588 (quote (module-ref))) (call-with-values (lambda () (value589 e590)) (lambda (id595 mod596) (build-global-reference220 s593 id595 mod596))) (if (memv type588 (quote (lexical-call))) (chi-application286 (build-lexical-reference217 (quote fun) (source-annotation239 (car e590)) (car e590) value589) e590 r591 w592 s593 mod594) (if (memv type588 (quote (global-call))) (chi-application286 (build-global-reference220 (source-annotation239 (car e590)) value589 (if (syntax-object?232 (car e590)) (syntax-object-module235 (car e590)) mod594)) e590 r591 w592 s593 mod594) (if (memv type588 (quote (constant))) (build-data226 s593 (strip294 (source-wrap277 e590 w592 s593 mod594) (quote (())))) (if (memv type588 (quote (global))) (build-global-reference220 s593 value589 mod594) (if (memv type588 (quote (call))) (chi-application286 (chi284 (car e590) r591 w592 mod594) e590 r591 w592 s593 mod594) (if (memv type588 (quote (begin-form))) ((lambda (tmp597) ((lambda (tmp598) (if tmp598 (apply (lambda (_599 e1600 e2601) (chi-sequence278 (cons e1600 e2601) r591 w592 s593 mod594)) tmp598) (syntax-violation #f "source expression failed to match any pattern" tmp597))) ($sc-dispatch tmp597 (quote (any any . each-any))))) e590) (if (memv type588 (quote (local-syntax-form))) (chi-local-syntax290 value589 e590 r591 w592 s593 mod594 chi-sequence278) (if (memv type588 (quote (eval-when-form))) ((lambda (tmp603) ((lambda (tmp604) (if tmp604 (apply (lambda (_605 x606 e1607 e2608) (let ((when-list609 (chi-when-list281 e590 x606 w592))) (if (memq (quote eval) when-list609) (chi-sequence278 (cons e1607 e2608) r591 w592 s593 mod594) (chi-void292)))) tmp604) (syntax-violation #f "source expression failed to match any pattern" tmp603))) ($sc-dispatch tmp603 (quote (any each-any any . each-any))))) e590) (if (memv type588 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e590 (wrap276 value589 w592 mod594)) (if (memv type588 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap277 e590 w592 s593 mod594)) (if (memv type588 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap277 e590 w592 s593 mod594)) (syntax-violation #f "unexpected syntax" (source-wrap277 e590 w592 s593 mod594)))))))))))))))))) (chi284 (lambda (e612 r613 w614 mod615) (call-with-values (lambda () (syntax-type282 e612 r613 w614 (source-annotation239 e612) #f mod615)) (lambda (type616 value617 e618 w619 s620 mod621) (chi-expr285 type616 value617 e618 r613 w619 s620 mod621))))) (chi-top283 (lambda (e622 r623 w624 m625 esew626 mod627) (call-with-values (lambda () (syntax-type282 e622 r623 w624 (source-annotation239 e622) #f mod627)) (lambda (type635 value636 e637 w638 s639 mod640) (if (memv type635 (quote (begin-form))) ((lambda (tmp641) ((lambda (tmp642) (if tmp642 (apply (lambda (_643) (chi-void292)) tmp642) ((lambda (tmp644) (if tmp644 (apply (lambda (_645 e1646 e2647) (chi-top-sequence279 (cons e1646 e2647) r623 w638 s639 m625 esew626 mod640)) tmp644) (syntax-violation #f "source expression failed to match any pattern" tmp641))) ($sc-dispatch tmp641 (quote (any any . each-any)))))) ($sc-dispatch tmp641 (quote (any))))) e637) (if (memv type635 (quote (local-syntax-form))) (chi-local-syntax290 value636 e637 r623 w638 s639 mod640 (lambda (body649 r650 w651 s652 mod653) (chi-top-sequence279 body649 r650 w651 s652 m625 esew626 mod653))) (if (memv type635 (quote (eval-when-form))) ((lambda (tmp654) ((lambda (tmp655) (if tmp655 (apply (lambda (_656 x657 e1658 e2659) (let ((when-list660 (chi-when-list281 e637 x657 w638)) (body661 (cons e1658 e2659))) (if (eq? m625 (quote e)) (if (memq (quote eval) when-list660) (chi-top-sequence279 body661 r623 w638 s639 (quote e) (quote (eval)) mod640) (chi-void292)) (if (memq (quote load) when-list660) (if (let ((t664 (memq (quote compile) when-list660))) (if t664 t664 (if (eq? m625 (quote c&e)) (memq (quote eval) when-list660) #f))) (chi-top-sequence279 body661 r623 w638 s639 (quote c&e) (quote (compile load)) mod640) (if (memq m625 (quote (c c&e))) (chi-top-sequence279 body661 r623 w638 s639 (quote c) (quote (load)) mod640) (chi-void292))) (if (let ((t665 (memq (quote compile) when-list660))) (if t665 t665 (if (eq? m625 (quote c&e)) (memq (quote eval) when-list660) #f))) (begin (top-level-eval-hook210 (chi-top-sequence279 body661 r623 w638 s639 (quote e) (quote (eval)) mod640) mod640) (chi-void292)) (chi-void292)))))) tmp655) (syntax-violation #f "source expression failed to match any pattern" tmp654))) ($sc-dispatch tmp654 (quote (any each-any any . each-any))))) e637) (if (memv type635 (quote (define-syntax-form))) (let ((n666 (id-var-name270 value636 w638)) (r667 (macros-only-env244 r623))) (if (memv m625 (quote (c))) (if (memq (quote compile) esew626) (let ((e668 (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)))) (begin (top-level-eval-hook210 e668 mod640) (if (memq (quote load) esew626) e668 (chi-void292)))) (if (memq (quote load) esew626) (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)) (chi-void292))) (if (memv m625 (quote (c&e))) (let ((e669 (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)))) (begin (top-level-eval-hook210 e669 mod640) e669)) (begin (if (memq (quote eval) esew626) (top-level-eval-hook210 (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)) mod640)) (chi-void292))))) (if (memv type635 (quote (define-form))) (let ((n670 (id-var-name270 value636 w638))) (let ((type671 (binding-type240 (lookup245 n670 r623 mod640)))) (if (memv type671 (quote (global core macro module-ref))) (let ((x672 (build-global-definition223 s639 n670 (chi284 e637 r623 w638 mod640)))) (begin (if (eq? m625 (quote c&e)) (top-level-eval-hook210 x672 mod640)) x672)) (if (memv type671 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e637 (wrap276 value636 w638 mod640)) (syntax-violation #f "cannot define keyword at top level" e637 (wrap276 value636 w638 mod640)))))) (let ((x673 (chi-expr285 type635 value636 e637 r623 w638 s639 mod640))) (begin (if (eq? m625 (quote c&e)) (top-level-eval-hook210 x673 mod640)) x673))))))))))) (syntax-type282 (lambda (e674 r675 w676 s677 rib678 mod679) (if (symbol? e674) (let ((n680 (id-var-name270 e674 w676))) (let ((b681 (lookup245 n680 r675 mod679))) (let ((type682 (binding-type240 b681))) (if (memv type682 (quote (lexical))) (values type682 (binding-value241 b681) e674 w676 s677 mod679) (if (memv type682 (quote (global))) (values type682 n680 e674 w676 s677 mod679) (if (memv type682 (quote (macro))) (syntax-type282 (chi-macro287 (binding-value241 b681) e674 r675 w676 rib678 mod679) r675 (quote (())) s677 rib678 mod679) (values type682 (binding-value241 b681) e674 w676 s677 mod679))))))) (if (pair? e674) (let ((first683 (car e674))) (if (id?248 first683) (let ((n684 (id-var-name270 first683 w676))) (let ((b685 (lookup245 n684 r675 (let ((t686 (if (syntax-object?232 first683) (syntax-object-module235 first683) #f))) (if t686 t686 mod679))))) (let ((type687 (binding-type240 b685))) (if (memv type687 (quote (lexical))) (values (quote lexical-call) (binding-value241 b685) e674 w676 s677 mod679) (if (memv type687 (quote (global))) (values (quote global-call) n684 e674 w676 s677 mod679) (if (memv type687 (quote (macro))) (syntax-type282 (chi-macro287 (binding-value241 b685) e674 r675 w676 rib678 mod679) r675 (quote (())) s677 rib678 mod679) (if (memv type687 (quote (core external-macro module-ref))) (values type687 (binding-value241 b685) e674 w676 s677 mod679) (if (memv type687 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value241 b685) e674 w676 s677 mod679) (if (memv type687 (quote (begin))) (values (quote begin-form) #f e674 w676 s677 mod679) (if (memv type687 (quote (eval-when))) (values (quote eval-when-form) #f e674 w676 s677 mod679) (if (memv type687 (quote (define))) ((lambda (tmp688) ((lambda (tmp689) (if (if tmp689 (apply (lambda (_690 name691 val692) (id?248 name691)) tmp689) #f) (apply (lambda (_693 name694 val695) (values (quote define-form) name694 val695 w676 s677 mod679)) tmp689) ((lambda (tmp696) (if (if tmp696 (apply (lambda (_697 name698 args699 e1700 e2701) (if (id?248 name698) (valid-bound-ids?273 (lambda-var-list296 args699)) #f)) tmp696) #f) (apply (lambda (_702 name703 args704 e1705 e2706) (values (quote define-form) (wrap276 name703 w676 mod679) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap276 (cons args704 (cons e1705 e2706)) w676 mod679)) (quote (())) s677 mod679)) tmp696) ((lambda (tmp708) (if (if tmp708 (apply (lambda (_709 name710) (id?248 name710)) tmp708) #f) (apply (lambda (_711 name712) (values (quote define-form) (wrap276 name712 w676 mod679) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s677 mod679)) tmp708) (syntax-violation #f "source expression failed to match any pattern" tmp688))) ($sc-dispatch tmp688 (quote (any any)))))) ($sc-dispatch tmp688 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp688 (quote (any any any))))) e674) (if (memv type687 (quote (define-syntax))) ((lambda (tmp713) ((lambda (tmp714) (if (if tmp714 (apply (lambda (_715 name716 val717) (id?248 name716)) tmp714) #f) (apply (lambda (_718 name719 val720) (values (quote define-syntax-form) name719 val720 w676 s677 mod679)) tmp714) (syntax-violation #f "source expression failed to match any pattern" tmp713))) ($sc-dispatch tmp713 (quote (any any any))))) e674) (values (quote call) #f e674 w676 s677 mod679))))))))))))) (values (quote call) #f e674 w676 s677 mod679))) (if (syntax-object?232 e674) (syntax-type282 (syntax-object-expression233 e674) r675 (join-wraps267 w676 (syntax-object-wrap234 e674)) s677 rib678 (let ((t721 (syntax-object-module235 e674))) (if t721 t721 mod679))) (if (self-evaluating? e674) (values (quote constant) #f e674 w676 s677 mod679) (values (quote other) #f e674 w676 s677 mod679))))))) (chi-when-list281 (lambda (e722 when-list723 w724) (letrec ((f725 (lambda (when-list726 situations727) (if (null? when-list726) situations727 (f725 (cdr when-list726) (cons (let ((x728 (car when-list726))) (if (free-id=?271 x728 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?271 x728 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?271 x728 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e722 (wrap276 x728 w724 #f)))))) situations727)))))) (f725 when-list723 (quote ()))))) (chi-install-global280 (lambda (name729 e730) (build-global-definition223 #f name729 (if (let ((v731 (module-variable (current-module) name729))) (if v731 (if (variable-bound? v731) (if (macro? (variable-ref v731)) (not (eq? (macro-type (variable-ref v731)) (quote syncase-macro))) #f) #f) #f)) (build-application215 #f (build-primref225 #f (quote make-extended-syncase-macro)) (list (build-application215 #f (build-primref225 #f (quote module-ref)) (list (build-application215 #f (build-primref225 #f (quote current-module)) (quote ())) (build-data226 #f name729))) (build-data226 #f (quote macro)) e730)) (build-application215 #f (build-primref225 #f (quote make-syncase-macro)) (list (build-data226 #f (quote macro)) e730)))))) (chi-top-sequence279 (lambda (body732 r733 w734 s735 m736 esew737 mod738) (build-sequence227 s735 (letrec ((dobody739 (lambda (body740 r741 w742 m743 esew744 mod745) (if (null? body740) (quote ()) (let ((first746 (chi-top283 (car body740) r741 w742 m743 esew744 mod745))) (cons first746 (dobody739 (cdr body740) r741 w742 m743 esew744 mod745))))))) (dobody739 body732 r733 w734 m736 esew737 mod738))))) (chi-sequence278 (lambda (body747 r748 w749 s750 mod751) (build-sequence227 s750 (letrec ((dobody752 (lambda (body753 r754 w755 mod756) (if (null? body753) (quote ()) (let ((first757 (chi284 (car body753) r754 w755 mod756))) (cons first757 (dobody752 (cdr body753) r754 w755 mod756))))))) (dobody752 body747 r748 w749 mod751))))) (source-wrap277 (lambda (x758 w759 s760 defmod761) (begin (if (if s760 (pair? x758) #f) (set-source-properties! x758 s760)) (wrap276 x758 w759 defmod761)))) (wrap276 (lambda (x762 w763 defmod764) (if (if (null? (wrap-marks251 w763)) (null? (wrap-subst252 w763)) #f) x762 (if (syntax-object?232 x762) (make-syntax-object231 (syntax-object-expression233 x762) (join-wraps267 w763 (syntax-object-wrap234 x762)) (syntax-object-module235 x762)) (if (null? x762) x762 (make-syntax-object231 x762 w763 defmod764)))))) (bound-id-member?275 (lambda (x765 list766) (if (not (null? list766)) (let ((t767 (bound-id=?272 x765 (car list766)))) (if t767 t767 (bound-id-member?275 x765 (cdr list766)))) #f))) (distinct-bound-ids?274 (lambda (ids768) (letrec ((distinct?769 (lambda (ids770) (let ((t771 (null? ids770))) (if t771 t771 (if (not (bound-id-member?275 (car ids770) (cdr ids770))) (distinct?769 (cdr ids770)) #f)))))) (distinct?769 ids768)))) (valid-bound-ids?273 (lambda (ids772) (if (letrec ((all-ids?773 (lambda (ids774) (let ((t775 (null? ids774))) (if t775 t775 (if (id?248 (car ids774)) (all-ids?773 (cdr ids774)) #f)))))) (all-ids?773 ids772)) (distinct-bound-ids?274 ids772) #f))) (bound-id=?272 (lambda (i776 j777) (if (if (syntax-object?232 i776) (syntax-object?232 j777) #f) (if (eq? (syntax-object-expression233 i776) (syntax-object-expression233 j777)) (same-marks?269 (wrap-marks251 (syntax-object-wrap234 i776)) (wrap-marks251 (syntax-object-wrap234 j777))) #f) (eq? i776 j777)))) (free-id=?271 (lambda (i778 j779) (if (eq? (let ((x780 i778)) (if (syntax-object?232 x780) (syntax-object-expression233 x780) x780)) (let ((x781 j779)) (if (syntax-object?232 x781) (syntax-object-expression233 x781) x781))) (eq? (id-var-name270 i778 (quote (()))) (id-var-name270 j779 (quote (())))) #f))) (id-var-name270 (lambda (id782 w783) (letrec ((search-vector-rib786 (lambda (sym792 subst793 marks794 symnames795 ribcage796) (let ((n797 (vector-length symnames795))) (letrec ((f798 (lambda (i799) (if (fx=208 i799 n797) (search784 sym792 (cdr subst793) marks794) (if (if (eq? (vector-ref symnames795 i799) sym792) (same-marks?269 marks794 (vector-ref (ribcage-marks258 ribcage796) i799)) #f) (values (vector-ref (ribcage-labels259 ribcage796) i799) marks794) (f798 (fx+206 i799 1))))))) (f798 0))))) (search-list-rib785 (lambda (sym800 subst801 marks802 symnames803 ribcage804) (letrec ((f805 (lambda (symnames806 i807) (if (null? symnames806) (search784 sym800 (cdr subst801) marks802) (if (if (eq? (car symnames806) sym800) (same-marks?269 marks802 (list-ref (ribcage-marks258 ribcage804) i807)) #f) (values (list-ref (ribcage-labels259 ribcage804) i807) marks802) (f805 (cdr symnames806) (fx+206 i807 1))))))) (f805 symnames803 0)))) (search784 (lambda (sym808 subst809 marks810) (if (null? subst809) (values #f marks810) (let ((fst811 (car subst809))) (if (eq? fst811 (quote shift)) (search784 sym808 (cdr subst809) (cdr marks810)) (let ((symnames812 (ribcage-symnames257 fst811))) (if (vector? symnames812) (search-vector-rib786 sym808 subst809 marks810 symnames812 fst811) (search-list-rib785 sym808 subst809 marks810 symnames812 fst811))))))))) (if (symbol? id782) (let ((t813 (call-with-values (lambda () (search784 id782 (wrap-subst252 w783) (wrap-marks251 w783))) (lambda (x815 . ignore814) x815)))) (if t813 t813 id782)) (if (syntax-object?232 id782) (let ((id816 (syntax-object-expression233 id782)) (w1817 (syntax-object-wrap234 id782))) (let ((marks818 (join-marks268 (wrap-marks251 w783) (wrap-marks251 w1817)))) (call-with-values (lambda () (search784 id816 (wrap-subst252 w783) marks818)) (lambda (new-id819 marks820) (let ((t821 new-id819)) (if t821 t821 (let ((t822 (call-with-values (lambda () (search784 id816 (wrap-subst252 w1817) marks820)) (lambda (x824 . ignore823) x824)))) (if t822 t822 id816)))))))) (syntax-violation (quote id-var-name) "invalid id" id782)))))) (same-marks?269 (lambda (x825 y826) (let ((t827 (eq? x825 y826))) (if t827 t827 (if (not (null? x825)) (if (not (null? y826)) (if (eq? (car x825) (car y826)) (same-marks?269 (cdr x825) (cdr y826)) #f) #f) #f))))) (join-marks268 (lambda (m1828 m2829) (smart-append266 m1828 m2829))) (join-wraps267 (lambda (w1830 w2831) (let ((m1832 (wrap-marks251 w1830)) (s1833 (wrap-subst252 w1830))) (if (null? m1832) (if (null? s1833) w2831 (make-wrap250 (wrap-marks251 w2831) (smart-append266 s1833 (wrap-subst252 w2831)))) (make-wrap250 (smart-append266 m1832 (wrap-marks251 w2831)) (smart-append266 s1833 (wrap-subst252 w2831))))))) (smart-append266 (lambda (m1834 m2835) (if (null? m2835) m1834 (append m1834 m2835)))) (make-binding-wrap265 (lambda (ids836 labels837 w838) (if (null? ids836) w838 (make-wrap250 (wrap-marks251 w838) (cons (let ((labelvec839 (list->vector labels837))) (let ((n840 (vector-length labelvec839))) (let ((symnamevec841 (make-vector n840)) (marksvec842 (make-vector n840))) (begin (letrec ((f843 (lambda (ids844 i845) (if (not (null? ids844)) (call-with-values (lambda () (id-sym-name&marks249 (car ids844) w838)) (lambda (symname846 marks847) (begin (vector-set! symnamevec841 i845 symname846) (vector-set! marksvec842 i845 marks847) (f843 (cdr ids844) (fx+206 i845 1))))))))) (f843 ids836 0)) (make-ribcage255 symnamevec841 marksvec842 labelvec839))))) (wrap-subst252 w838)))))) (extend-ribcage!264 (lambda (ribcage848 id849 label850) (begin (set-ribcage-symnames!260 ribcage848 (cons (syntax-object-expression233 id849) (ribcage-symnames257 ribcage848))) (set-ribcage-marks!261 ribcage848 (cons (wrap-marks251 (syntax-object-wrap234 id849)) (ribcage-marks258 ribcage848))) (set-ribcage-labels!262 ribcage848 (cons label850 (ribcage-labels259 ribcage848)))))) (anti-mark263 (lambda (w851) (make-wrap250 (cons #f (wrap-marks251 w851)) (cons (quote shift) (wrap-subst252 w851))))) (set-ribcage-labels!262 (lambda (x852 update853) (vector-set! x852 3 update853))) (set-ribcage-marks!261 (lambda (x854 update855) (vector-set! x854 2 update855))) (set-ribcage-symnames!260 (lambda (x856 update857) (vector-set! x856 1 update857))) (ribcage-labels259 (lambda (x858) (vector-ref x858 3))) (ribcage-marks258 (lambda (x859) (vector-ref x859 2))) (ribcage-symnames257 (lambda (x860) (vector-ref x860 1))) (ribcage?256 (lambda (x861) (if (vector? x861) (if (= (vector-length x861) 4) (eq? (vector-ref x861 0) (quote ribcage)) #f) #f))) (make-ribcage255 (lambda (symnames862 marks863 labels864) (vector (quote ribcage) symnames862 marks863 labels864))) (gen-labels254 (lambda (ls865) (if (null? ls865) (quote ()) (cons (gen-label253) (gen-labels254 (cdr ls865)))))) (gen-label253 (lambda () (string #\i))) (wrap-subst252 cdr) (wrap-marks251 car) (make-wrap250 cons) (id-sym-name&marks249 (lambda (x866 w867) (if (syntax-object?232 x866) (values (syntax-object-expression233 x866) (join-marks268 (wrap-marks251 w867) (wrap-marks251 (syntax-object-wrap234 x866)))) (values x866 (wrap-marks251 w867))))) (id?248 (lambda (x868) (if (symbol? x868) #t (if (syntax-object?232 x868) (symbol? (syntax-object-expression233 x868)) #f)))) (nonsymbol-id?247 (lambda (x869) (if (syntax-object?232 x869) (symbol? (syntax-object-expression233 x869)) #f))) (global-extend246 (lambda (type870 sym871 val872) (put-global-definition-hook212 sym871 type870 val872))) (lookup245 (lambda (x873 r874 mod875) (let ((t876 (assq x873 r874))) (if t876 (cdr t876) (if (symbol? x873) (let ((t877 (get-global-definition-hook213 x873 mod875))) (if t877 t877 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env244 (lambda (r878) (if (null? r878) (quote ()) (let ((a879 (car r878))) (if (eq? (cadr a879) (quote macro)) (cons a879 (macros-only-env244 (cdr r878))) (macros-only-env244 (cdr r878))))))) (extend-var-env243 (lambda (labels880 vars881 r882) (if (null? labels880) r882 (extend-var-env243 (cdr labels880) (cdr vars881) (cons (cons (car labels880) (cons (quote lexical) (car vars881))) r882))))) (extend-env242 (lambda (labels883 bindings884 r885) (if (null? labels883) r885 (extend-env242 (cdr labels883) (cdr bindings884) (cons (cons (car labels883) (car bindings884)) r885))))) (binding-value241 cdr) (binding-type240 car) (source-annotation239 (lambda (x886) (if (syntax-object?232 x886) (source-annotation239 (syntax-object-expression233 x886)) (if (pair? x886) (let ((props887 (source-properties x886))) (if (pair? props887) props887 #f)) #f)))) (set-syntax-object-module!238 (lambda (x888 update889) (vector-set! x888 3 update889))) (set-syntax-object-wrap!237 (lambda (x890 update891) (vector-set! x890 2 update891))) (set-syntax-object-expression!236 (lambda (x892 update893) (vector-set! x892 1 update893))) (syntax-object-module235 (lambda (x894) (vector-ref x894 3))) (syntax-object-wrap234 (lambda (x895) (vector-ref x895 2))) (syntax-object-expression233 (lambda (x896) (vector-ref x896 1))) (syntax-object?232 (lambda (x897) (if (vector? x897) (if (= (vector-length x897) 4) (eq? (vector-ref x897 0) (quote syntax-object)) #f) #f))) (make-syntax-object231 (lambda (expression898 wrap899 module900) (vector (quote syntax-object) expression898 wrap899 module900))) (build-letrec230 (lambda (src901 ids902 vars903 val-exps904 body-exp905) (if (null? vars903) body-exp905 (let ((atom-key906 (fluid-ref *mode*205))) (if (memv atom-key906 (quote (c))) (begin (for-each maybe-name-value!222 ids902 val-exps904) ((@ (language tree-il) make-letrec) src901 ids902 vars903 val-exps904 body-exp905)) (list (quote letrec) (map list vars903 val-exps904) body-exp905)))))) (build-named-let229 (lambda (src907 ids908 vars909 val-exps910 body-exp911) (let ((f912 (car vars909)) (f-name913 (car ids908)) (vars914 (cdr vars909)) (ids915 (cdr ids908))) (let ((atom-key916 (fluid-ref *mode*205))) (if (memv atom-key916 (quote (c))) (let ((proc917 (build-lambda224 src907 ids915 vars914 #f body-exp911))) (begin (maybe-name-value!222 f-name913 proc917) (for-each maybe-name-value!222 ids915 val-exps910) ((@ (language tree-il) make-letrec) src907 (list f-name913) (list f912) (list proc917) (build-application215 src907 (build-lexical-reference217 (quote fun) src907 f-name913 f912) val-exps910)))) (list (quote let) f912 (map list vars914 val-exps910) body-exp911)))))) (build-let228 (lambda (src918 ids919 vars920 val-exps921 body-exp922) (if (null? vars920) body-exp922 (let ((atom-key923 (fluid-ref *mode*205))) (if (memv atom-key923 (quote (c))) (begin (for-each maybe-name-value!222 ids919 val-exps921) ((@ (language tree-il) make-let) src918 ids919 vars920 val-exps921 body-exp922)) (list (quote let) (map list vars920 val-exps921) body-exp922)))))) (build-sequence227 (lambda (src924 exps925) (if (null? (cdr exps925)) (car exps925) (let ((atom-key926 (fluid-ref *mode*205))) (if (memv atom-key926 (quote (c))) ((@ (language tree-il) make-sequence) src924 exps925) (cons (quote begin) exps925)))))) (build-data226 (lambda (src927 exp928) (let ((atom-key929 (fluid-ref *mode*205))) (if (memv atom-key929 (quote (c))) ((@ (language tree-il) make-const) src927 exp928) (if (if (self-evaluating? exp928) (not (vector? exp928)) #f) exp928 (list (quote quote) exp928)))))) (build-primref225 (lambda (src930 name931) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key932 (fluid-ref *mode*205))) (if (memv atom-key932 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src930 name931) name931)) (let ((atom-key933 (fluid-ref *mode*205))) (if (memv atom-key933 (quote (c))) ((@ (language tree-il) make-module-ref) src930 (quote (guile)) name931 #f) (list (quote @@) (quote (guile)) name931)))))) (build-lambda224 (lambda (src934 ids935 vars936 docstring937 exp938) (let ((atom-key939 (fluid-ref *mode*205))) (if (memv atom-key939 (quote (c))) ((@ (language tree-il) make-lambda) src934 ids935 vars936 (if docstring937 (list (cons (quote documentation) docstring937)) (quote ())) exp938) (cons (quote lambda) (cons vars936 (append (if docstring937 (list docstring937) (quote ())) (list exp938)))))))) (build-global-definition223 (lambda (source940 var941 exp942) (let ((atom-key943 (fluid-ref *mode*205))) (if (memv atom-key943 (quote (c))) (begin (maybe-name-value!222 var941 exp942) ((@ (language tree-il) make-toplevel-define) source940 var941 exp942)) (list (quote define) var941 exp942))))) (maybe-name-value!222 (lambda (name944 val945) (if ((@ (language tree-il) lambda?) val945) (let ((meta946 ((@ (language tree-il) lambda-meta) val945))) (if (not (assq (quote name) meta946)) ((setter (@ (language tree-il) lambda-meta)) val945 (acons (quote name) name944 meta946))))))) (build-global-assignment221 (lambda (source947 var948 exp949 mod950) (analyze-variable219 mod950 var948 (lambda (mod951 var952 public?953) (let ((atom-key954 (fluid-ref *mode*205))) (if (memv atom-key954 (quote (c))) ((@ (language tree-il) make-module-set) source947 mod951 var952 public?953 exp949) (list (quote set!) (list (if public?953 (quote @) (quote @@)) mod951 var952) exp949)))) (lambda (var955) (let ((atom-key956 (fluid-ref *mode*205))) (if (memv atom-key956 (quote (c))) ((@ (language tree-il) make-toplevel-set) source947 var955 exp949) (list (quote set!) var955 exp949))))))) (build-global-reference220 (lambda (source957 var958 mod959) (analyze-variable219 mod959 var958 (lambda (mod960 var961 public?962) (let ((atom-key963 (fluid-ref *mode*205))) (if (memv atom-key963 (quote (c))) ((@ (language tree-il) make-module-ref) source957 mod960 var961 public?962) (list (if public?962 (quote @) (quote @@)) mod960 var961)))) (lambda (var964) (let ((atom-key965 (fluid-ref *mode*205))) (if (memv atom-key965 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source957 var964) var964)))))) (analyze-variable219 (lambda (mod966 var967 modref-cont968 bare-cont969) (if (not mod966) (bare-cont969 var967) (let ((kind970 (car mod966)) (mod971 (cdr mod966))) (if (memv kind970 (quote (public))) (modref-cont968 mod971 var967 #t) (if (memv kind970 (quote (private))) (if (not (equal? mod971 (module-name (current-module)))) (modref-cont968 mod971 var967 #f) (bare-cont969 var967)) (if (memv kind970 (quote (bare))) (bare-cont969 var967) (if (memv kind970 (quote (hygiene))) (if (if (not (equal? mod971 (module-name (current-module)))) (module-variable (resolve-module mod971) var967) #f) (modref-cont968 mod971 var967 #f) (bare-cont969 var967)) (syntax-violation #f "bad module kind" var967 mod971))))))))) (build-lexical-assignment218 (lambda (source972 name973 var974 exp975) (let ((atom-key976 (fluid-ref *mode*205))) (if (memv atom-key976 (quote (c))) ((@ (language tree-il) make-lexical-set) source972 name973 var974 exp975) (list (quote set!) var974 exp975))))) (build-lexical-reference217 (lambda (type977 source978 name979 var980) (let ((atom-key981 (fluid-ref *mode*205))) (if (memv atom-key981 (quote (c))) ((@ (language tree-il) make-lexical-ref) source978 name979 var980) var980)))) (build-conditional216 (lambda (source982 test-exp983 then-exp984 else-exp985) (let ((atom-key986 (fluid-ref *mode*205))) (if (memv atom-key986 (quote (c))) ((@ (language tree-il) make-conditional) source982 test-exp983 then-exp984 else-exp985) (if (equal? else-exp985 (quote (if #f #f))) (list (quote if) test-exp983 then-exp984) (list (quote if) test-exp983 then-exp984 else-exp985)))))) (build-application215 (lambda (source987 fun-exp988 arg-exps989) (let ((atom-key990 (fluid-ref *mode*205))) (if (memv atom-key990 (quote (c))) ((@ (language tree-il) make-application) source987 fun-exp988 arg-exps989) (cons fun-exp988 arg-exps989))))) (build-void214 (lambda (source991) (let ((atom-key992 (fluid-ref *mode*205))) (if (memv atom-key992 (quote (c))) ((@ (language tree-il) make-void) source991) (quote (if #f #f)))))) (get-global-definition-hook213 (lambda (symbol993 module994) (begin (if (if (not module994) (current-module) #f) (warn "module system is booted, we should have a module" symbol993)) (let ((v995 (module-variable (if module994 (resolve-module (cdr module994)) (current-module)) symbol993))) (if v995 (if (variable-bound? v995) (let ((val996 (variable-ref v995))) (if (macro? val996) (if (syncase-macro-type val996) (cons (syncase-macro-type val996) (syncase-macro-binding val996)) #f) #f)) #f) #f))))) (put-global-definition-hook212 (lambda (symbol997 type998 val999) (let ((existing1000 (let ((v1001 (module-variable (current-module) symbol997))) (if v1001 (if (variable-bound? v1001) (let ((val1002 (variable-ref v1001))) (if (macro? val1002) (if (not (syncase-macro-type val1002)) val1002 #f) #f)) #f) #f)))) (module-define! (current-module) symbol997 (if existing1000 (make-extended-syncase-macro existing1000 type998 val999) (make-syncase-macro type998 val999)))))) (local-eval-hook211 (lambda (x1003 mod1004) (primitive-eval (list noexpand204 (let ((atom-key1005 (fluid-ref *mode*205))) (if (memv atom-key1005 (quote (c))) ((@ (language tree-il) tree-il->scheme) x1003) x1003)))))) (top-level-eval-hook210 (lambda (x1006 mod1007) (primitive-eval (list noexpand204 (let ((atom-key1008 (fluid-ref *mode*205))) (if (memv atom-key1008 (quote (c))) ((@ (language tree-il) tree-il->scheme) x1006) x1006)))))) (fx<209 <) (fx=208 =) (fx-207 -) (fx+206 +) (*mode*205 (make-fluid)) (noexpand204 "noexpand")) (begin (global-extend246 (quote local-syntax) (quote letrec-syntax) #t) (global-extend246 (quote local-syntax) (quote let-syntax) #f) (global-extend246 (quote core) (quote fluid-let-syntax) (lambda (e1009 r1010 w1011 s1012 mod1013) ((lambda (tmp1014) ((lambda (tmp1015) (if (if tmp1015 (apply (lambda (_1016 var1017 val1018 e11019 e21020) (valid-bound-ids?273 var1017)) tmp1015) #f) (apply (lambda (_1022 var1023 val1024 e11025 e21026) (let ((names1027 (map (lambda (x1028) (id-var-name270 x1028 w1011)) var1023))) (begin (for-each (lambda (id1030 n1031) (let ((atom-key1032 (binding-type240 (lookup245 n1031 r1010 mod1013)))) (if (memv atom-key1032 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1009 (source-wrap277 id1030 w1011 s1012 mod1013))))) var1023 names1027) (chi-body288 (cons e11025 e21026) (source-wrap277 e1009 w1011 s1012 mod1013) (extend-env242 names1027 (let ((trans-r1035 (macros-only-env244 r1010))) (map (lambda (x1036) (cons (quote macro) (eval-local-transformer291 (chi284 x1036 trans-r1035 w1011 mod1013) mod1013))) val1024)) r1010) w1011 mod1013)))) tmp1015) ((lambda (_1038) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap277 e1009 w1011 s1012 mod1013))) tmp1014))) ($sc-dispatch tmp1014 (quote (any #(each (any any)) any . each-any))))) e1009))) (global-extend246 (quote core) (quote quote) (lambda (e1039 r1040 w1041 s1042 mod1043) ((lambda (tmp1044) ((lambda (tmp1045) (if tmp1045 (apply (lambda (_1046 e1047) (build-data226 s1042 (strip294 e1047 w1041))) tmp1045) ((lambda (_1048) (syntax-violation (quote quote) "bad syntax" (source-wrap277 e1039 w1041 s1042 mod1043))) tmp1044))) ($sc-dispatch tmp1044 (quote (any any))))) e1039))) (global-extend246 (quote core) (quote syntax) (letrec ((regen1056 (lambda (x1057) (let ((atom-key1058 (car x1057))) (if (memv atom-key1058 (quote (ref))) (build-lexical-reference217 (quote value) #f (cadr x1057) (cadr x1057)) (if (memv atom-key1058 (quote (primitive))) (build-primref225 #f (cadr x1057)) (if (memv atom-key1058 (quote (quote))) (build-data226 #f (cadr x1057)) (if (memv atom-key1058 (quote (lambda))) (build-lambda224 #f (cadr x1057) (cadr x1057) #f (regen1056 (caddr x1057))) (build-application215 #f (build-primref225 #f (car x1057)) (map regen1056 (cdr x1057)))))))))) (gen-vector1055 (lambda (x1059) (if (eq? (car x1059) (quote list)) (cons (quote vector) (cdr x1059)) (if (eq? (car x1059) (quote quote)) (list (quote quote) (list->vector (cadr x1059))) (list (quote list->vector) x1059))))) (gen-append1054 (lambda (x1060 y1061) (if (equal? y1061 (quote (quote ()))) x1060 (list (quote append) x1060 y1061)))) (gen-cons1053 (lambda (x1062 y1063) (let ((atom-key1064 (car y1063))) (if (memv atom-key1064 (quote (quote))) (if (eq? (car x1062) (quote quote)) (list (quote quote) (cons (cadr x1062) (cadr y1063))) (if (eq? (cadr y1063) (quote ())) (list (quote list) x1062) (list (quote cons) x1062 y1063))) (if (memv atom-key1064 (quote (list))) (cons (quote list) (cons x1062 (cdr y1063))) (list (quote cons) x1062 y1063)))))) (gen-map1052 (lambda (e1065 map-env1066) (let ((formals1067 (map cdr map-env1066)) (actuals1068 (map (lambda (x1069) (list (quote ref) (car x1069))) map-env1066))) (if (eq? (car e1065) (quote ref)) (car actuals1068) (if (and-map (lambda (x1070) (if (eq? (car x1070) (quote ref)) (memq (cadr x1070) formals1067) #f)) (cdr e1065)) (cons (quote map) (cons (list (quote primitive) (car e1065)) (map (let ((r1071 (map cons formals1067 actuals1068))) (lambda (x1072) (cdr (assq (cadr x1072) r1071)))) (cdr e1065)))) (cons (quote map) (cons (list (quote lambda) formals1067 e1065) actuals1068))))))) (gen-mappend1051 (lambda (e1073 map-env1074) (list (quote apply) (quote (primitive append)) (gen-map1052 e1073 map-env1074)))) (gen-ref1050 (lambda (src1075 var1076 level1077 maps1078) (if (fx=208 level1077 0) (values var1076 maps1078) (if (null? maps1078) (syntax-violation (quote syntax) "missing ellipsis" src1075) (call-with-values (lambda () (gen-ref1050 src1075 var1076 (fx-207 level1077 1) (cdr maps1078))) (lambda (outer-var1079 outer-maps1080) (let ((b1081 (assq outer-var1079 (car maps1078)))) (if b1081 (values (cdr b1081) maps1078) (let ((inner-var1082 (gen-var295 (quote tmp)))) (values inner-var1082 (cons (cons (cons outer-var1079 inner-var1082) (car maps1078)) outer-maps1080))))))))))) (gen-syntax1049 (lambda (src1083 e1084 r1085 maps1086 ellipsis?1087 mod1088) (if (id?248 e1084) (let ((label1089 (id-var-name270 e1084 (quote (()))))) (let ((b1090 (lookup245 label1089 r1085 mod1088))) (if (eq? (binding-type240 b1090) (quote syntax)) (call-with-values (lambda () (let ((var.lev1091 (binding-value241 b1090))) (gen-ref1050 src1083 (car var.lev1091) (cdr var.lev1091) maps1086))) (lambda (var1092 maps1093) (values (list (quote ref) var1092) maps1093))) (if (ellipsis?1087 e1084) (syntax-violation (quote syntax) "misplaced ellipsis" src1083) (values (list (quote quote) e1084) maps1086))))) ((lambda (tmp1094) ((lambda (tmp1095) (if (if tmp1095 (apply (lambda (dots1096 e1097) (ellipsis?1087 dots1096)) tmp1095) #f) (apply (lambda (dots1098 e1099) (gen-syntax1049 src1083 e1099 r1085 maps1086 (lambda (x1100) #f) mod1088)) tmp1095) ((lambda (tmp1101) (if (if tmp1101 (apply (lambda (x1102 dots1103 y1104) (ellipsis?1087 dots1103)) tmp1101) #f) (apply (lambda (x1105 dots1106 y1107) (letrec ((f1108 (lambda (y1109 k1110) ((lambda (tmp1114) ((lambda (tmp1115) (if (if tmp1115 (apply (lambda (dots1116 y1117) (ellipsis?1087 dots1116)) tmp1115) #f) (apply (lambda (dots1118 y1119) (f1108 y1119 (lambda (maps1120) (call-with-values (lambda () (k1110 (cons (quote ()) maps1120))) (lambda (x1121 maps1122) (if (null? (car maps1122)) (syntax-violation (quote syntax) "extra ellipsis" src1083) (values (gen-mappend1051 x1121 (car maps1122)) (cdr maps1122)))))))) tmp1115) ((lambda (_1123) (call-with-values (lambda () (gen-syntax1049 src1083 y1109 r1085 maps1086 ellipsis?1087 mod1088)) (lambda (y1124 maps1125) (call-with-values (lambda () (k1110 maps1125)) (lambda (x1126 maps1127) (values (gen-append1054 x1126 y1124) maps1127)))))) tmp1114))) ($sc-dispatch tmp1114 (quote (any . any))))) y1109)))) (f1108 y1107 (lambda (maps1111) (call-with-values (lambda () (gen-syntax1049 src1083 x1105 r1085 (cons (quote ()) maps1111) ellipsis?1087 mod1088)) (lambda (x1112 maps1113) (if (null? (car maps1113)) (syntax-violation (quote syntax) "extra ellipsis" src1083) (values (gen-map1052 x1112 (car maps1113)) (cdr maps1113))))))))) tmp1101) ((lambda (tmp1128) (if tmp1128 (apply (lambda (x1129 y1130) (call-with-values (lambda () (gen-syntax1049 src1083 x1129 r1085 maps1086 ellipsis?1087 mod1088)) (lambda (x1131 maps1132) (call-with-values (lambda () (gen-syntax1049 src1083 y1130 r1085 maps1132 ellipsis?1087 mod1088)) (lambda (y1133 maps1134) (values (gen-cons1053 x1131 y1133) maps1134)))))) tmp1128) ((lambda (tmp1135) (if tmp1135 (apply (lambda (e11136 e21137) (call-with-values (lambda () (gen-syntax1049 src1083 (cons e11136 e21137) r1085 maps1086 ellipsis?1087 mod1088)) (lambda (e1139 maps1140) (values (gen-vector1055 e1139) maps1140)))) tmp1135) ((lambda (_1141) (values (list (quote quote) e1084) maps1086)) tmp1094))) ($sc-dispatch tmp1094 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp1094 (quote (any . any)))))) ($sc-dispatch tmp1094 (quote (any any . any)))))) ($sc-dispatch tmp1094 (quote (any any))))) e1084))))) (lambda (e1142 r1143 w1144 s1145 mod1146) (let ((e1147 (source-wrap277 e1142 w1144 s1145 mod1146))) ((lambda (tmp1148) ((lambda (tmp1149) (if tmp1149 (apply (lambda (_1150 x1151) (call-with-values (lambda () (gen-syntax1049 e1147 x1151 r1143 (quote ()) ellipsis?293 mod1146)) (lambda (e1152 maps1153) (regen1056 e1152)))) tmp1149) ((lambda (_1154) (syntax-violation (quote syntax) "bad `syntax' form" e1147)) tmp1148))) ($sc-dispatch tmp1148 (quote (any any))))) e1147))))) (global-extend246 (quote core) (quote lambda) (lambda (e1155 r1156 w1157 s1158 mod1159) ((lambda (tmp1160) ((lambda (tmp1161) (if tmp1161 (apply (lambda (_1162 c1163) (chi-lambda-clause289 (source-wrap277 e1155 w1157 s1158 mod1159) #f c1163 r1156 w1157 mod1159 (lambda (names1164 vars1165 docstring1166 body1167) (build-lambda224 s1158 names1164 vars1165 docstring1166 body1167)))) tmp1161) (syntax-violation #f "source expression failed to match any pattern" tmp1160))) ($sc-dispatch tmp1160 (quote (any . any))))) e1155))) (global-extend246 (quote core) (quote let) (letrec ((chi-let1168 (lambda (e1169 r1170 w1171 s1172 mod1173 constructor1174 ids1175 vals1176 exps1177) (if (not (valid-bound-ids?273 ids1175)) (syntax-violation (quote let) "duplicate bound variable" e1169) (let ((labels1178 (gen-labels254 ids1175)) (new-vars1179 (map gen-var295 ids1175))) (let ((nw1180 (make-binding-wrap265 ids1175 labels1178 w1171)) (nr1181 (extend-var-env243 labels1178 new-vars1179 r1170))) (constructor1174 s1172 (map syntax->datum ids1175) new-vars1179 (map (lambda (x1182) (chi284 x1182 r1170 w1171 mod1173)) vals1176) (chi-body288 exps1177 (source-wrap277 e1169 nw1180 s1172 mod1173) nr1181 nw1180 mod1173)))))))) (lambda (e1183 r1184 w1185 s1186 mod1187) ((lambda (tmp1188) ((lambda (tmp1189) (if (if tmp1189 (apply (lambda (_1190 id1191 val1192 e11193 e21194) (and-map id?248 id1191)) tmp1189) #f) (apply (lambda (_1196 id1197 val1198 e11199 e21200) (chi-let1168 e1183 r1184 w1185 s1186 mod1187 build-let228 id1197 val1198 (cons e11199 e21200))) tmp1189) ((lambda (tmp1204) (if (if tmp1204 (apply (lambda (_1205 f1206 id1207 val1208 e11209 e21210) (if (id?248 f1206) (and-map id?248 id1207) #f)) tmp1204) #f) (apply (lambda (_1212 f1213 id1214 val1215 e11216 e21217) (chi-let1168 e1183 r1184 w1185 s1186 mod1187 build-named-let229 (cons f1213 id1214) val1215 (cons e11216 e21217))) tmp1204) ((lambda (_1221) (syntax-violation (quote let) "bad let" (source-wrap277 e1183 w1185 s1186 mod1187))) tmp1188))) ($sc-dispatch tmp1188 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1188 (quote (any #(each (any any)) any . each-any))))) e1183)))) (global-extend246 (quote core) (quote letrec) (lambda (e1222 r1223 w1224 s1225 mod1226) ((lambda (tmp1227) ((lambda (tmp1228) (if (if tmp1228 (apply (lambda (_1229 id1230 val1231 e11232 e21233) (and-map id?248 id1230)) tmp1228) #f) (apply (lambda (_1235 id1236 val1237 e11238 e21239) (let ((ids1240 id1236)) (if (not (valid-bound-ids?273 ids1240)) (syntax-violation (quote letrec) "duplicate bound variable" e1222) (let ((labels1242 (gen-labels254 ids1240)) (new-vars1243 (map gen-var295 ids1240))) (let ((w1244 (make-binding-wrap265 ids1240 labels1242 w1224)) (r1245 (extend-var-env243 labels1242 new-vars1243 r1223))) (build-letrec230 s1225 (map syntax->datum ids1240) new-vars1243 (map (lambda (x1246) (chi284 x1246 r1245 w1244 mod1226)) val1237) (chi-body288 (cons e11238 e21239) (source-wrap277 e1222 w1244 s1225 mod1226) r1245 w1244 mod1226))))))) tmp1228) ((lambda (_1249) (syntax-violation (quote letrec) "bad letrec" (source-wrap277 e1222 w1224 s1225 mod1226))) tmp1227))) ($sc-dispatch tmp1227 (quote (any #(each (any any)) any . each-any))))) e1222))) (global-extend246 (quote core) (quote set!) (lambda (e1250 r1251 w1252 s1253 mod1254) ((lambda (tmp1255) ((lambda (tmp1256) (if (if tmp1256 (apply (lambda (_1257 id1258 val1259) (id?248 id1258)) tmp1256) #f) (apply (lambda (_1260 id1261 val1262) (let ((val1263 (chi284 val1262 r1251 w1252 mod1254)) (n1264 (id-var-name270 id1261 w1252))) (let ((b1265 (lookup245 n1264 r1251 mod1254))) (let ((atom-key1266 (binding-type240 b1265))) (if (memv atom-key1266 (quote (lexical))) (build-lexical-assignment218 s1253 (syntax->datum id1261) (binding-value241 b1265) val1263) (if (memv atom-key1266 (quote (global))) (build-global-assignment221 s1253 n1264 val1263 mod1254) (if (memv atom-key1266 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap276 id1261 w1252 mod1254)) (syntax-violation (quote set!) "bad set!" (source-wrap277 e1250 w1252 s1253 mod1254))))))))) tmp1256) ((lambda (tmp1267) (if tmp1267 (apply (lambda (_1268 head1269 tail1270 val1271) (call-with-values (lambda () (syntax-type282 head1269 r1251 (quote (())) #f #f mod1254)) (lambda (type1272 value1273 ee1274 ww1275 ss1276 modmod1277) (if (memv type1272 (quote (module-ref))) (let ((val1278 (chi284 val1271 r1251 w1252 mod1254))) (call-with-values (lambda () (value1273 (cons head1269 tail1270))) (lambda (id1280 mod1281) (build-global-assignment221 s1253 id1280 val1278 mod1281)))) (build-application215 s1253 (chi284 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head1269) r1251 w1252 mod1254) (map (lambda (e1282) (chi284 e1282 r1251 w1252 mod1254)) (append tail1270 (list val1271)))))))) tmp1267) ((lambda (_1284) (syntax-violation (quote set!) "bad set!" (source-wrap277 e1250 w1252 s1253 mod1254))) tmp1255))) ($sc-dispatch tmp1255 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1255 (quote (any any any))))) e1250))) (global-extend246 (quote module-ref) (quote @) (lambda (e1285) ((lambda (tmp1286) ((lambda (tmp1287) (if (if tmp1287 (apply (lambda (_1288 mod1289 id1290) (if (and-map id?248 mod1289) (id?248 id1290) #f)) tmp1287) #f) (apply (lambda (_1292 mod1293 id1294) (values (syntax->datum id1294) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1293)))) tmp1287) (syntax-violation #f "source expression failed to match any pattern" tmp1286))) ($sc-dispatch tmp1286 (quote (any each-any any))))) e1285))) (global-extend246 (quote module-ref) (quote @@) (lambda (e1296) ((lambda (tmp1297) ((lambda (tmp1298) (if (if tmp1298 (apply (lambda (_1299 mod1300 id1301) (if (and-map id?248 mod1300) (id?248 id1301) #f)) tmp1298) #f) (apply (lambda (_1303 mod1304 id1305) (values (syntax->datum id1305) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1304)))) tmp1298) (syntax-violation #f "source expression failed to match any pattern" tmp1297))) ($sc-dispatch tmp1297 (quote (any each-any any))))) e1296))) (global-extend246 (quote core) (quote if) (lambda (e1307 r1308 w1309 s1310 mod1311) ((lambda (tmp1312) ((lambda (tmp1313) (if tmp1313 (apply (lambda (_1314 test1315 then1316) (build-conditional216 s1310 (chi284 test1315 r1308 w1309 mod1311) (chi284 then1316 r1308 w1309 mod1311) (build-void214 #f))) tmp1313) ((lambda (tmp1317) (if tmp1317 (apply (lambda (_1318 test1319 then1320 else1321) (build-conditional216 s1310 (chi284 test1319 r1308 w1309 mod1311) (chi284 then1320 r1308 w1309 mod1311) (chi284 else1321 r1308 w1309 mod1311))) tmp1317) (syntax-violation #f "source expression failed to match any pattern" tmp1312))) ($sc-dispatch tmp1312 (quote (any any any any)))))) ($sc-dispatch tmp1312 (quote (any any any))))) e1307))) (global-extend246 (quote begin) (quote begin) (quote ())) (global-extend246 (quote define) (quote define) (quote ())) (global-extend246 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend246 (quote eval-when) (quote eval-when) (quote ())) (global-extend246 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1325 (lambda (x1326 keys1327 clauses1328 r1329 mod1330) (if (null? clauses1328) (build-application215 #f (build-primref225 #f (quote syntax-violation)) (list (build-data226 #f #f) (build-data226 #f "source expression failed to match any pattern") x1326)) ((lambda (tmp1331) ((lambda (tmp1332) (if tmp1332 (apply (lambda (pat1333 exp1334) (if (if (id?248 pat1333) (and-map (lambda (x1335) (not (free-id=?271 pat1333 x1335))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys1327)) #f) (let ((labels1336 (list (gen-label253))) (var1337 (gen-var295 pat1333))) (build-application215 #f (build-lambda224 #f (list (syntax->datum pat1333)) (list var1337) #f (chi284 exp1334 (extend-env242 labels1336 (list (cons (quote syntax) (cons var1337 0))) r1329) (make-binding-wrap265 (list pat1333) labels1336 (quote (()))) mod1330)) (list x1326))) (gen-clause1324 x1326 keys1327 (cdr clauses1328) r1329 pat1333 #t exp1334 mod1330))) tmp1332) ((lambda (tmp1338) (if tmp1338 (apply (lambda (pat1339 fender1340 exp1341) (gen-clause1324 x1326 keys1327 (cdr clauses1328) r1329 pat1339 fender1340 exp1341 mod1330)) tmp1338) ((lambda (_1342) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1328))) tmp1331))) ($sc-dispatch tmp1331 (quote (any any any)))))) ($sc-dispatch tmp1331 (quote (any any))))) (car clauses1328))))) (gen-clause1324 (lambda (x1343 keys1344 clauses1345 r1346 pat1347 fender1348 exp1349 mod1350) (call-with-values (lambda () (convert-pattern1322 pat1347 keys1344)) (lambda (p1351 pvars1352) (if (not (distinct-bound-ids?274 (map car pvars1352))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1347) (if (not (and-map (lambda (x1353) (not (ellipsis?293 (car x1353)))) pvars1352)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1347) (let ((y1354 (gen-var295 (quote tmp)))) (build-application215 #f (build-lambda224 #f (list (quote tmp)) (list y1354) #f (let ((y1355 (build-lexical-reference217 (quote value) #f (quote tmp) y1354))) (build-conditional216 #f ((lambda (tmp1356) ((lambda (tmp1357) (if tmp1357 (apply (lambda () y1355) tmp1357) ((lambda (_1358) (build-conditional216 #f y1355 (build-dispatch-call1323 pvars1352 fender1348 y1355 r1346 mod1350) (build-data226 #f #f))) tmp1356))) ($sc-dispatch tmp1356 (quote #(atom #t))))) fender1348) (build-dispatch-call1323 pvars1352 exp1349 y1355 r1346 mod1350) (gen-syntax-case1325 x1343 keys1344 clauses1345 r1346 mod1350)))) (list (if (eq? p1351 (quote any)) (build-application215 #f (build-primref225 #f (quote list)) (list x1343)) (build-application215 #f (build-primref225 #f (quote $sc-dispatch)) (list x1343 (build-data226 #f p1351))))))))))))) (build-dispatch-call1323 (lambda (pvars1359 exp1360 y1361 r1362 mod1363) (let ((ids1364 (map car pvars1359)) (levels1365 (map cdr pvars1359))) (let ((labels1366 (gen-labels254 ids1364)) (new-vars1367 (map gen-var295 ids1364))) (build-application215 #f (build-primref225 #f (quote apply)) (list (build-lambda224 #f (map syntax->datum ids1364) new-vars1367 #f (chi284 exp1360 (extend-env242 labels1366 (map (lambda (var1368 level1369) (cons (quote syntax) (cons var1368 level1369))) new-vars1367 (map cdr pvars1359)) r1362) (make-binding-wrap265 ids1364 labels1366 (quote (()))) mod1363)) y1361)))))) (convert-pattern1322 (lambda (pattern1370 keys1371) (letrec ((cvt1372 (lambda (p1373 n1374 ids1375) (if (id?248 p1373) (if (bound-id-member?275 p1373 keys1371) (values (vector (quote free-id) p1373) ids1375) (values (quote any) (cons (cons p1373 n1374) ids1375))) ((lambda (tmp1376) ((lambda (tmp1377) (if (if tmp1377 (apply (lambda (x1378 dots1379) (ellipsis?293 dots1379)) tmp1377) #f) (apply (lambda (x1380 dots1381) (call-with-values (lambda () (cvt1372 x1380 (fx+206 n1374 1) ids1375)) (lambda (p1382 ids1383) (values (if (eq? p1382 (quote any)) (quote each-any) (vector (quote each) p1382)) ids1383)))) tmp1377) ((lambda (tmp1384) (if tmp1384 (apply (lambda (x1385 y1386) (call-with-values (lambda () (cvt1372 y1386 n1374 ids1375)) (lambda (y1387 ids1388) (call-with-values (lambda () (cvt1372 x1385 n1374 ids1388)) (lambda (x1389 ids1390) (values (cons x1389 y1387) ids1390)))))) tmp1384) ((lambda (tmp1391) (if tmp1391 (apply (lambda () (values (quote ()) ids1375)) tmp1391) ((lambda (tmp1392) (if tmp1392 (apply (lambda (x1393) (call-with-values (lambda () (cvt1372 x1393 n1374 ids1375)) (lambda (p1395 ids1396) (values (vector (quote vector) p1395) ids1396)))) tmp1392) ((lambda (x1397) (values (vector (quote atom) (strip294 p1373 (quote (())))) ids1375)) tmp1376))) ($sc-dispatch tmp1376 (quote #(vector each-any)))))) ($sc-dispatch tmp1376 (quote ()))))) ($sc-dispatch tmp1376 (quote (any . any)))))) ($sc-dispatch tmp1376 (quote (any any))))) p1373))))) (cvt1372 pattern1370 0 (quote ())))))) (lambda (e1398 r1399 w1400 s1401 mod1402) (let ((e1403 (source-wrap277 e1398 w1400 s1401 mod1402))) ((lambda (tmp1404) ((lambda (tmp1405) (if tmp1405 (apply (lambda (_1406 val1407 key1408 m1409) (if (and-map (lambda (x1410) (if (id?248 x1410) (not (ellipsis?293 x1410)) #f)) key1408) (let ((x1412 (gen-var295 (quote tmp)))) (build-application215 s1401 (build-lambda224 #f (list (quote tmp)) (list x1412) #f (gen-syntax-case1325 (build-lexical-reference217 (quote value) #f (quote tmp) x1412) key1408 m1409 r1399 mod1402)) (list (chi284 val1407 r1399 (quote (())) mod1402)))) (syntax-violation (quote syntax-case) "invalid literals list" e1403))) tmp1405) (syntax-violation #f "source expression failed to match any pattern" tmp1404))) ($sc-dispatch tmp1404 (quote (any any each-any . each-any))))) e1403))))) (set! sc-expand (lambda (x1416 . rest1415) (if (if (pair? x1416) (equal? (car x1416) noexpand204) #f) (cadr x1416) (let ((m1417 (if (null? rest1415) (quote e) (car rest1415))) (esew1418 (if (let ((t1419 (null? rest1415))) (if t1419 t1419 (null? (cdr rest1415)))) (quote (eval)) (cadr rest1415)))) (with-fluid* *mode*205 m1417 (lambda () (chi-top283 x1416 (quote ()) (quote ((top))) m1417 esew1418 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1420) (nonsymbol-id?247 x1420))) (set! datum->syntax (lambda (id1421 datum1422) (make-syntax-object231 datum1422 (syntax-object-wrap234 id1421) #f))) (set! syntax->datum (lambda (x1423) (strip294 x1423 (quote (()))))) (set! generate-temporaries (lambda (ls1424) (begin (let ((x1425 ls1424)) (if (not (list? x1425)) (syntax-violation (quote generate-temporaries) "invalid argument" x1425))) (map (lambda (x1426) (wrap276 (gensym) (quote ((top))) #f)) ls1424)))) (set! free-identifier=? (lambda (x1427 y1428) (begin (let ((x1429 x1427)) (if (not (nonsymbol-id?247 x1429)) (syntax-violation (quote free-identifier=?) "invalid argument" x1429))) (let ((x1430 y1428)) (if (not (nonsymbol-id?247 x1430)) (syntax-violation (quote free-identifier=?) "invalid argument" x1430))) (free-id=?271 x1427 y1428)))) (set! bound-identifier=? (lambda (x1431 y1432) (begin (let ((x1433 x1431)) (if (not (nonsymbol-id?247 x1433)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1433))) (let ((x1434 y1432)) (if (not (nonsymbol-id?247 x1434)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1434))) (bound-id=?272 x1431 y1432)))) (set! syntax-violation (lambda (who1438 message1437 form1436 . subform1435) (begin (let ((x1439 who1438)) (if (not ((lambda (x1440) (let ((t1441 (not x1440))) (if t1441 t1441 (let ((t1442 (string? x1440))) (if t1442 t1442 (symbol? x1440)))))) x1439)) (syntax-violation (quote syntax-violation) "invalid argument" x1439))) (let ((x1443 message1437)) (if (not (string? x1443)) (syntax-violation (quote syntax-violation) "invalid argument" x1443))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1438 "~a: " "") "~a " (if (null? subform1435) "in ~a" "in subform `~s' of `~s'")) (let ((tail1444 (cons message1437 (map (lambda (x1445) (strip294 x1445 (quote (())))) (append subform1435 (list form1436)))))) (if who1438 (cons who1438 tail1444) tail1444)) #f)))) (letrec ((match1450 (lambda (e1451 p1452 w1453 r1454 mod1455) (if (not r1454) #f (if (eq? p1452 (quote any)) (cons (wrap276 e1451 w1453 mod1455) r1454) (if (syntax-object?232 e1451) (match*1449 (syntax-object-expression233 e1451) p1452 (join-wraps267 w1453 (syntax-object-wrap234 e1451)) r1454 (syntax-object-module235 e1451)) (match*1449 e1451 p1452 w1453 r1454 mod1455)))))) (match*1449 (lambda (e1456 p1457 w1458 r1459 mod1460) (if (null? p1457) (if (null? e1456) r1459 #f) (if (pair? p1457) (if (pair? e1456) (match1450 (car e1456) (car p1457) w1458 (match1450 (cdr e1456) (cdr p1457) w1458 r1459 mod1460) mod1460) #f) (if (eq? p1457 (quote each-any)) (let ((l1461 (match-each-any1447 e1456 w1458 mod1460))) (if l1461 (cons l1461 r1459) #f)) (let ((atom-key1462 (vector-ref p1457 0))) (if (memv atom-key1462 (quote (each))) (if (null? e1456) (match-empty1448 (vector-ref p1457 1) r1459) (let ((l1463 (match-each1446 e1456 (vector-ref p1457 1) w1458 mod1460))) (if l1463 (letrec ((collect1464 (lambda (l1465) (if (null? (car l1465)) r1459 (cons (map car l1465) (collect1464 (map cdr l1465))))))) (collect1464 l1463)) #f))) (if (memv atom-key1462 (quote (free-id))) (if (id?248 e1456) (if (free-id=?271 (wrap276 e1456 w1458 mod1460) (vector-ref p1457 1)) r1459 #f) #f) (if (memv atom-key1462 (quote (atom))) (if (equal? (vector-ref p1457 1) (strip294 e1456 w1458)) r1459 #f) (if (memv atom-key1462 (quote (vector))) (if (vector? e1456) (match1450 (vector->list e1456) (vector-ref p1457 1) w1458 r1459 mod1460) #f))))))))))) (match-empty1448 (lambda (p1466 r1467) (if (null? p1466) r1467 (if (eq? p1466 (quote any)) (cons (quote ()) r1467) (if (pair? p1466) (match-empty1448 (car p1466) (match-empty1448 (cdr p1466) r1467)) (if (eq? p1466 (quote each-any)) (cons (quote ()) r1467) (let ((atom-key1468 (vector-ref p1466 0))) (if (memv atom-key1468 (quote (each))) (match-empty1448 (vector-ref p1466 1) r1467) (if (memv atom-key1468 (quote (free-id atom))) r1467 (if (memv atom-key1468 (quote (vector))) (match-empty1448 (vector-ref p1466 1) r1467))))))))))) (match-each-any1447 (lambda (e1469 w1470 mod1471) (if (pair? e1469) (let ((l1472 (match-each-any1447 (cdr e1469) w1470 mod1471))) (if l1472 (cons (wrap276 (car e1469) w1470 mod1471) l1472) #f)) (if (null? e1469) (quote ()) (if (syntax-object?232 e1469) (match-each-any1447 (syntax-object-expression233 e1469) (join-wraps267 w1470 (syntax-object-wrap234 e1469)) mod1471) #f))))) (match-each1446 (lambda (e1473 p1474 w1475 mod1476) (if (pair? e1473) (let ((first1477 (match1450 (car e1473) p1474 w1475 (quote ()) mod1476))) (if first1477 (let ((rest1478 (match-each1446 (cdr e1473) p1474 w1475 mod1476))) (if rest1478 (cons first1477 rest1478) #f)) #f)) (if (null? e1473) (quote ()) (if (syntax-object?232 e1473) (match-each1446 (syntax-object-expression233 e1473) p1474 (join-wraps267 w1475 (syntax-object-wrap234 e1473)) (syntax-object-module235 e1473)) #f)))))) (set! $sc-dispatch (lambda (e1479 p1480) (if (eq? p1480 (quote any)) (list e1479) (if (syntax-object?232 e1479) (match*1449 (syntax-object-expression233 e1479) p1480 (syntax-object-wrap234 e1479) (quote ()) (syntax-object-module235 e1479)) (match*1449 e1479 p1480 (quote (())) (quote ()) #f)))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x1481) ((lambda (tmp1482) ((lambda (tmp1483) (if tmp1483 (apply (lambda (_1484 e11485 e21486) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11485 e21486))) tmp1483) ((lambda (tmp1488) (if tmp1488 (apply (lambda (_1489 out1490 in1491 e11492 e21493) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in1491 (quote ()) (list out1490 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11492 e21493))))) tmp1488) ((lambda (tmp1495) (if tmp1495 (apply (lambda (_1496 out1497 in1498 e11499 e21500) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in1498) (quote ()) (list out1497 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11499 e21500))))) tmp1495) (syntax-violation #f "source expression failed to match any pattern" tmp1482))) ($sc-dispatch tmp1482 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1482 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1482 (quote (any () any . each-any))))) x1481))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1504) ((lambda (tmp1505) ((lambda (tmp1506) (if tmp1506 (apply (lambda (_1507 k1508 keyword1509 pattern1510 template1511) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k1508 (map (lambda (tmp1514 tmp1513) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp1513) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp1514))) template1511 pattern1510)))))) tmp1506) (syntax-violation #f "source expression failed to match any pattern" tmp1505))) ($sc-dispatch tmp1505 (quote (any each-any . #(each ((any . any) any))))))) x1504))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1515) ((lambda (tmp1516) ((lambda (tmp1517) (if (if tmp1517 (apply (lambda (let*1518 x1519 v1520 e11521 e21522) (and-map identifier? x1519)) tmp1517) #f) (apply (lambda (let*1524 x1525 v1526 e11527 e21528) (letrec ((f1529 (lambda (bindings1530) (if (null? bindings1530) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e11527 e21528))) ((lambda (tmp1534) ((lambda (tmp1535) (if tmp1535 (apply (lambda (body1536 binding1537) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding1537) body1536)) tmp1535) (syntax-violation #f "source expression failed to match any pattern" tmp1534))) ($sc-dispatch tmp1534 (quote (any any))))) (list (f1529 (cdr bindings1530)) (car bindings1530))))))) (f1529 (map list x1525 v1526)))) tmp1517) (syntax-violation #f "source expression failed to match any pattern" tmp1516))) ($sc-dispatch tmp1516 (quote (any #(each (any any)) any . each-any))))) x1515))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1538) ((lambda (tmp1539) ((lambda (tmp1540) (if tmp1540 (apply (lambda (_1541 var1542 init1543 step1544 e01545 e11546 c1547) ((lambda (tmp1548) ((lambda (tmp1549) (if tmp1549 (apply (lambda (step1550) ((lambda (tmp1551) ((lambda (tmp1552) (if tmp1552 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1542 init1543) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01545) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1547 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1550))))))) tmp1552) ((lambda (tmp1557) (if tmp1557 (apply (lambda (e11558 e21559) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1542 init1543) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01545 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e11558 e21559)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1547 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1550))))))) tmp1557) (syntax-violation #f "source expression failed to match any pattern" tmp1551))) ($sc-dispatch tmp1551 (quote (any . each-any)))))) ($sc-dispatch tmp1551 (quote ())))) e11546)) tmp1549) (syntax-violation #f "source expression failed to match any pattern" tmp1548))) ($sc-dispatch tmp1548 (quote each-any)))) (map (lambda (v1566 s1567) ((lambda (tmp1568) ((lambda (tmp1569) (if tmp1569 (apply (lambda () v1566) tmp1569) ((lambda (tmp1570) (if tmp1570 (apply (lambda (e1571) e1571) tmp1570) ((lambda (_1572) (syntax-violation (quote do) "bad step expression" orig-x1538 s1567)) tmp1568))) ($sc-dispatch tmp1568 (quote (any)))))) ($sc-dispatch tmp1568 (quote ())))) s1567)) var1542 step1544))) tmp1540) (syntax-violation #f "source expression failed to match any pattern" tmp1539))) ($sc-dispatch tmp1539 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1538))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1575 (lambda (x1579 y1580) ((lambda (tmp1581) ((lambda (tmp1582) (if tmp1582 (apply (lambda (x1583 y1584) ((lambda (tmp1585) ((lambda (tmp1586) (if tmp1586 (apply (lambda (dy1587) ((lambda (tmp1588) ((lambda (tmp1589) (if tmp1589 (apply (lambda (dx1590) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx1590 dy1587))) tmp1589) ((lambda (_1591) (if (null? dy1587) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1583) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1583 y1584))) tmp1588))) ($sc-dispatch tmp1588 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x1583)) tmp1586) ((lambda (tmp1592) (if tmp1592 (apply (lambda (stuff1593) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x1583 stuff1593))) tmp1592) ((lambda (else1594) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1583 y1584)) tmp1585))) ($sc-dispatch tmp1585 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1585 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y1584)) tmp1582) (syntax-violation #f "source expression failed to match any pattern" tmp1581))) ($sc-dispatch tmp1581 (quote (any any))))) (list x1579 y1580)))) (quasiappend1576 (lambda (x1595 y1596) ((lambda (tmp1597) ((lambda (tmp1598) (if tmp1598 (apply (lambda (x1599 y1600) ((lambda (tmp1601) ((lambda (tmp1602) (if tmp1602 (apply (lambda () x1599) tmp1602) ((lambda (_1603) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1599 y1600)) tmp1601))) ($sc-dispatch tmp1601 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y1600)) tmp1598) (syntax-violation #f "source expression failed to match any pattern" tmp1597))) ($sc-dispatch tmp1597 (quote (any any))))) (list x1595 y1596)))) (quasivector1577 (lambda (x1604) ((lambda (tmp1605) ((lambda (x1606) ((lambda (tmp1607) ((lambda (tmp1608) (if tmp1608 (apply (lambda (x1609) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x1609))) tmp1608) ((lambda (tmp1611) (if tmp1611 (apply (lambda (x1612) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1612)) tmp1611) ((lambda (_1614) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1606)) tmp1607))) ($sc-dispatch tmp1607 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp1607 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x1606)) tmp1605)) x1604))) (quasi1578 (lambda (p1615 lev1616) ((lambda (tmp1617) ((lambda (tmp1618) (if tmp1618 (apply (lambda (p1619) (if (= lev1616 0) p1619 (quasicons1575 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1578 (list p1619) (- lev1616 1))))) tmp1618) ((lambda (tmp1620) (if (if tmp1620 (apply (lambda (args1621) (= lev1616 0)) tmp1620) #f) (apply (lambda (args1622) (syntax-violation (quote unquote) "unquote takes exactly one argument" p1615 (cons (quote #(syntax-object unquote ((top) #(ribcage #(args) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1622))) tmp1620) ((lambda (tmp1623) (if tmp1623 (apply (lambda (p1624 q1625) (if (= lev1616 0) (quasiappend1576 p1624 (quasi1578 q1625 lev1616)) (quasicons1575 (quasicons1575 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1578 (list p1624) (- lev1616 1))) (quasi1578 q1625 lev1616)))) tmp1623) ((lambda (tmp1626) (if (if tmp1626 (apply (lambda (args1627 q1628) (= lev1616 0)) tmp1626) #f) (apply (lambda (args1629 q1630) (syntax-violation (quote unquote-splicing) "unquote-splicing takes exactly one argument" p1615 (cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1629))) tmp1626) ((lambda (tmp1631) (if tmp1631 (apply (lambda (p1632) (quasicons1575 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1578 (list p1632) (+ lev1616 1)))) tmp1631) ((lambda (tmp1633) (if tmp1633 (apply (lambda (p1634 q1635) (quasicons1575 (quasi1578 p1634 lev1616) (quasi1578 q1635 lev1616))) tmp1633) ((lambda (tmp1636) (if tmp1636 (apply (lambda (x1637) (quasivector1577 (quasi1578 x1637 lev1616))) tmp1636) ((lambda (p1639) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p1639)) tmp1617))) ($sc-dispatch tmp1617 (quote #(vector each-any)))))) ($sc-dispatch tmp1617 (quote (any . any)))))) ($sc-dispatch tmp1617 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp1617 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any) . any)))))) ($sc-dispatch tmp1617 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp1617 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1617 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p1615)))) (lambda (x1640) ((lambda (tmp1641) ((lambda (tmp1642) (if tmp1642 (apply (lambda (_1643 e1644) (quasi1578 e1644 0)) tmp1642) (syntax-violation #f "source expression failed to match any pattern" tmp1641))) ($sc-dispatch tmp1641 (quote (any any))))) x1640)))))
-(define include (make-syncase-macro (quote macro) (lambda (x1645) (letrec ((read-file1646 (lambda (fn1647 k1648) (let ((p1649 (open-input-file fn1647))) (letrec ((f1650 (lambda (x1651) (if (eof-object? x1651) (begin (close-input-port p1649) (quote ())) (cons (datum->syntax k1648 x1651) (f1650 (read p1649))))))) (f1650 (read p1649))))))) ((lambda (tmp1652) ((lambda (tmp1653) (if tmp1653 (apply (lambda (k1654 filename1655) (let ((fn1656 (syntax->datum filename1655))) ((lambda (tmp1657) ((lambda (tmp1658) (if tmp1658 (apply (lambda (exp1659) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp1659)) tmp1658) (syntax-violation #f "source expression failed to match any pattern" tmp1657))) ($sc-dispatch tmp1657 (quote each-any)))) (read-file1646 fn1656 k1654)))) tmp1653) (syntax-violation #f "source expression failed to match any pattern" tmp1652))) ($sc-dispatch tmp1652 (quote (any any))))) x1645)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x1661) ((lambda (tmp1662) ((lambda (tmp1663) (if tmp1663 (apply (lambda (_1664 e1665) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1661)) tmp1663) (syntax-violation #f "source expression failed to match any pattern" tmp1662))) ($sc-dispatch tmp1662 (quote (any any))))) x1661))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1666) ((lambda (tmp1667) ((lambda (tmp1668) (if tmp1668 (apply (lambda (_1669 e1670) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1666)) tmp1668) (syntax-violation #f "source expression failed to match any pattern" tmp1667))) ($sc-dispatch tmp1667 (quote (any any))))) x1666))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x1671) ((lambda (tmp1672) ((lambda (tmp1673) (if tmp1673 (apply (lambda (_1674 e1675 m11676 m21677) ((lambda (tmp1678) ((lambda (body1679) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1675)) body1679)) tmp1678)) (letrec ((f1680 (lambda (clause1681 clauses1682) (if (null? clauses1682) ((lambda (tmp1684) ((lambda (tmp1685) (if tmp1685 (apply (lambda (e11686 e21687) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11686 e21687))) tmp1685) ((lambda (tmp1689) (if tmp1689 (apply (lambda (k1690 e11691 e21692) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1690)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11691 e21692)))) tmp1689) ((lambda (_1695) (syntax-violation (quote case) "bad clause" x1671 clause1681)) tmp1684))) ($sc-dispatch tmp1684 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1684 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause1681) ((lambda (tmp1696) ((lambda (rest1697) ((lambda (tmp1698) ((lambda (tmp1699) (if tmp1699 (apply (lambda (k1700 e11701 e21702) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1700)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11701 e21702)) rest1697)) tmp1699) ((lambda (_1705) (syntax-violation (quote case) "bad clause" x1671 clause1681)) tmp1698))) ($sc-dispatch tmp1698 (quote (each-any any . each-any))))) clause1681)) tmp1696)) (f1680 (car clauses1682) (cdr clauses1682))))))) (f1680 m11676 m21677)))) tmp1673) (syntax-violation #f "source expression failed to match any pattern" tmp1672))) ($sc-dispatch tmp1672 (quote (any any any . each-any))))) x1671))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1706) ((lambda (tmp1707) ((lambda (tmp1708) (if tmp1708 (apply (lambda (_1709 e1710) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1710)) (list (cons _1709 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e1710 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp1708) (syntax-violation #f "source expression failed to match any pattern" tmp1707))) ($sc-dispatch tmp1707 (quote (any any))))) x1706))))
+(letrec ((and-map*17 (lambda (f57 first56 . rest55) (let ((t58 (null? first56))) (if t58 t58 (if (null? rest55) (letrec ((andmap59 (lambda (first60) (let ((x61 (car first60)) (first62 (cdr first60))) (if (null? first62) (f57 x61) (if (f57 x61) (andmap59 first62) #f)))))) (andmap59 first56)) (letrec ((andmap63 (lambda (first64 rest65) (let ((x66 (car first64)) (xr67 (map car rest65)) (first68 (cdr first64)) (rest69 (map cdr rest65))) (if (null? first68) (apply f57 (cons x66 xr67)) (if (apply f57 (cons x66 xr67)) (andmap63 first68 rest69) #f)))))) (andmap63 first56 rest55)))))))) (letrec ((lambda-var-list162 (lambda (vars286) (letrec ((lvl287 (lambda (vars288 ls289 w290) (if (pair? vars288) (lvl287 (cdr vars288) (cons (wrap142 (car vars288) w290 #f) ls289) w290) (if (id?114 vars288) (cons (wrap142 vars288 w290 #f) ls289) (if (null? vars288) ls289 (if (syntax-object?98 vars288) (lvl287 (syntax-object-expression99 vars288) ls289 (join-wraps133 w290 (syntax-object-wrap100 vars288))) (cons vars288 ls289)))))))) (lvl287 vars286 (quote ()) (quote (())))))) (gen-var161 (lambda (id291) (let ((id292 (if (syntax-object?98 id291) (syntax-object-expression99 id291) id291))) (gensym (symbol->string id292))))) (strip160 (lambda (x293 w294) (if (memq (quote top) (wrap-marks117 w294)) x293 (letrec ((f295 (lambda (x296) (if (syntax-object?98 x296) (strip160 (syntax-object-expression99 x296) (syntax-object-wrap100 x296)) (if (pair? x296) (let ((a297 (f295 (car x296))) (d298 (f295 (cdr x296)))) (if (if (eq? a297 (car x296)) (eq? d298 (cdr x296)) #f) x296 (cons a297 d298))) (if (vector? x296) (let ((old299 (vector->list x296))) (let ((new300 (map f295 old299))) (if (and-map*17 eq? old299 new300) x296 (list->vector new300)))) x296)))))) (f295 x293))))) (ellipsis?159 (lambda (x301) (if (nonsymbol-id?113 x301) (free-id=?137 x301 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void158 (lambda () (build-void80 #f))) (eval-local-transformer157 (lambda (expanded302 mod303) (let ((p304 (local-eval-hook77 expanded302 mod303))) (if (procedure? p304) p304 (syntax-violation #f "nonprocedure transformer" p304))))) (chi-local-syntax156 (lambda (rec?305 e306 r307 w308 s309 mod310 k311) ((lambda (tmp312) ((lambda (tmp313) (if tmp313 (apply (lambda (_314 id315 val316 e1317 e2318) (let ((ids319 id315)) (if (not (valid-bound-ids?139 ids319)) (syntax-violation #f "duplicate bound keyword" e306) (let ((labels321 (gen-labels120 ids319))) (let ((new-w322 (make-binding-wrap131 ids319 labels321 w308))) (k311 (cons e1317 e2318) (extend-env108 labels321 (let ((w324 (if rec?305 new-w322 w308)) (trans-r325 (macros-only-env110 r307))) (map (lambda (x326) (cons (quote macro) (eval-local-transformer157 (chi150 x326 trans-r325 w324 mod310) mod310))) val316)) r307) new-w322 s309 mod310)))))) tmp313) ((lambda (_328) (syntax-violation #f "bad local syntax definition" (source-wrap143 e306 w308 s309 mod310))) tmp312))) ($sc-dispatch tmp312 (quote (any #(each (any any)) any . each-any))))) e306))) (chi-lambda-clause155 (lambda (e329 docstring330 c331 r332 w333 mod334 k335) ((lambda (tmp336) ((lambda (tmp337) (if (if tmp337 (apply (lambda (args338 doc339 e1340 e2341) (if (string? (syntax->datum doc339)) (not docstring330) #f)) tmp337) #f) (apply (lambda (args342 doc343 e1344 e2345) (chi-lambda-clause155 e329 doc343 (cons args342 (cons e1344 e2345)) r332 w333 mod334 k335)) tmp337) ((lambda (tmp347) (if tmp347 (apply (lambda (id348 e1349 e2350) (let ((ids351 id348)) (if (not (valid-bound-ids?139 ids351)) (syntax-violation (quote lambda) "invalid parameter list" e329) (let ((labels353 (gen-labels120 ids351)) (new-vars354 (map gen-var161 ids351))) (k335 (map syntax->datum ids351) new-vars354 (if docstring330 (syntax->datum docstring330) #f) (chi-body154 (cons e1349 e2350) e329 (extend-var-env109 labels353 new-vars354 r332) (make-binding-wrap131 ids351 labels353 w333) mod334)))))) tmp347) ((lambda (tmp356) (if tmp356 (apply (lambda (ids357 e1358 e2359) (let ((old-ids360 (lambda-var-list162 ids357))) (if (not (valid-bound-ids?139 old-ids360)) (syntax-violation (quote lambda) "invalid parameter list" e329) (let ((labels361 (gen-labels120 old-ids360)) (new-vars362 (map gen-var161 old-ids360))) (k335 (letrec ((f363 (lambda (ls1364 ls2365) (if (null? ls1364) (syntax->datum ls2365) (f363 (cdr ls1364) (cons (syntax->datum (car ls1364)) ls2365)))))) (f363 (cdr old-ids360) (car old-ids360))) (letrec ((f366 (lambda (ls1367 ls2368) (if (null? ls1367) ls2368 (f366 (cdr ls1367) (cons (car ls1367) ls2368)))))) (f366 (cdr new-vars362) (car new-vars362))) (if docstring330 (syntax->datum docstring330) #f) (chi-body154 (cons e1358 e2359) e329 (extend-var-env109 labels361 new-vars362 r332) (make-binding-wrap131 old-ids360 labels361 w333) mod334)))))) tmp356) ((lambda (_370) (syntax-violation (quote lambda) "bad lambda" e329)) tmp336))) ($sc-dispatch tmp336 (quote (any any . each-any)))))) ($sc-dispatch tmp336 (quote (each-any any . each-any)))))) ($sc-dispatch tmp336 (quote (any any any . each-any))))) c331))) (chi-body154 (lambda (body371 outer-form372 r373 w374 mod375) (let ((r376 (cons (quote ("placeholder" placeholder)) r373))) (let ((ribcage377 (make-ribcage121 (quote ()) (quote ()) (quote ())))) (let ((w378 (make-wrap116 (wrap-marks117 w374) (cons ribcage377 (wrap-subst118 w374))))) (letrec ((parse379 (lambda (body380 ids381 labels382 var-ids383 vars384 vals385 bindings386) (if (null? body380) (syntax-violation #f "no expressions in body" outer-form372) (let ((e388 (cdar body380)) (er389 (caar body380))) (call-with-values (lambda () (syntax-type148 e388 er389 (quote (())) (source-annotation105 er389) ribcage377 mod375 #f)) (lambda (type390 value391 e392 w393 s394 mod395) (if (memv type390 (quote (define-form))) (let ((id396 (wrap142 value391 w393 mod395)) (label397 (gen-label119))) (let ((var398 (gen-var161 id396))) (begin (extend-ribcage!130 ribcage377 id396 label397) (parse379 (cdr body380) (cons id396 ids381) (cons label397 labels382) (cons id396 var-ids383) (cons var398 vars384) (cons (cons er389 (wrap142 e392 w393 mod395)) vals385) (cons (cons (quote lexical) var398) bindings386))))) (if (memv type390 (quote (define-syntax-form))) (let ((id399 (wrap142 value391 w393 mod395)) (label400 (gen-label119))) (begin (extend-ribcage!130 ribcage377 id399 label400) (parse379 (cdr body380) (cons id399 ids381) (cons label400 labels382) var-ids383 vars384 vals385 (cons (cons (quote macro) (cons er389 (wrap142 e392 w393 mod395))) bindings386)))) (if (memv type390 (quote (begin-form))) ((lambda (tmp401) ((lambda (tmp402) (if tmp402 (apply (lambda (_403 e1404) (parse379 (letrec ((f405 (lambda (forms406) (if (null? forms406) (cdr body380) (cons (cons er389 (wrap142 (car forms406) w393 mod395)) (f405 (cdr forms406))))))) (f405 e1404)) ids381 labels382 var-ids383 vars384 vals385 bindings386)) tmp402) (syntax-violation #f "source expression failed to match any pattern" tmp401))) ($sc-dispatch tmp401 (quote (any . each-any))))) e392) (if (memv type390 (quote (local-syntax-form))) (chi-local-syntax156 value391 e392 er389 w393 s394 mod395 (lambda (forms408 er409 w410 s411 mod412) (parse379 (letrec ((f413 (lambda (forms414) (if (null? forms414) (cdr body380) (cons (cons er409 (wrap142 (car forms414) w410 mod412)) (f413 (cdr forms414))))))) (f413 forms408)) ids381 labels382 var-ids383 vars384 vals385 bindings386))) (if (null? ids381) (build-sequence93 #f (map (lambda (x415) (chi150 (cdr x415) (car x415) (quote (())) mod395)) (cons (cons er389 (source-wrap143 e392 w393 s394 mod395)) (cdr body380)))) (begin (if (not (valid-bound-ids?139 ids381)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form372)) (letrec ((loop416 (lambda (bs417 er-cache418 r-cache419) (if (not (null? bs417)) (let ((b420 (car bs417))) (if (eq? (car b420) (quote macro)) (let ((er421 (cadr b420))) (let ((r-cache422 (if (eq? er421 er-cache418) r-cache419 (macros-only-env110 er421)))) (begin (set-cdr! b420 (eval-local-transformer157 (chi150 (cddr b420) r-cache422 (quote (())) mod395) mod395)) (loop416 (cdr bs417) er421 r-cache422)))) (loop416 (cdr bs417) er-cache418 r-cache419))))))) (loop416 bindings386 #f #f)) (set-cdr! r376 (extend-env108 labels382 bindings386 (cdr r376))) (build-letrec96 #f (map syntax->datum var-ids383) vars384 (map (lambda (x423) (chi150 (cdr x423) (car x423) (quote (())) mod395)) vals385) (build-sequence93 #f (map (lambda (x424) (chi150 (cdr x424) (car x424) (quote (())) mod395)) (cons (cons er389 (source-wrap143 e392 w393 s394 mod395)) (cdr body380)))))))))))))))))) (parse379 (map (lambda (x387) (cons r376 (wrap142 x387 w378 mod375))) body371) (quote ()) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro153 (lambda (p425 e426 r427 w428 rib429 mod430) (letrec ((rebuild-macro-output431 (lambda (x432 m433) (if (pair? x432) (cons (rebuild-macro-output431 (car x432) m433) (rebuild-macro-output431 (cdr x432) m433)) (if (syntax-object?98 x432) (let ((w434 (syntax-object-wrap100 x432))) (let ((ms435 (wrap-marks117 w434)) (s436 (wrap-subst118 w434))) (if (if (pair? ms435) (eq? (car ms435) #f) #f) (make-syntax-object97 (syntax-object-expression99 x432) (make-wrap116 (cdr ms435) (if rib429 (cons rib429 (cdr s436)) (cdr s436))) (syntax-object-module101 x432)) (make-syntax-object97 (syntax-object-expression99 x432) (make-wrap116 (cons m433 ms435) (if rib429 (cons rib429 (cons (quote shift) s436)) (cons (quote shift) s436))) (let ((pmod437 (procedure-module p425))) (if pmod437 (cons (quote hygiene) (module-name pmod437)) (quote (hygiene guile)))))))) (if (vector? x432) (let ((n438 (vector-length x432))) (let ((v439 (make-vector n438))) (letrec ((loop440 (lambda (i441) (if (fx=74 i441 n438) (begin (if #f #f) v439) (begin (vector-set! v439 i441 (rebuild-macro-output431 (vector-ref x432 i441) m433)) (loop440 (fx+72 i441 1))))))) (loop440 0)))) (if (symbol? x432) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap143 e426 w428 s mod430) x432) x432))))))) (rebuild-macro-output431 (p425 (wrap142 e426 (anti-mark129 w428) mod430)) (string #\m))))) (chi-application152 (lambda (x442 e443 r444 w445 s446 mod447) ((lambda (tmp448) ((lambda (tmp449) (if tmp449 (apply (lambda (e0450 e1451) (build-application81 s446 x442 (map (lambda (e452) (chi150 e452 r444 w445 mod447)) e1451))) tmp449) (syntax-violation #f "source expression failed to match any pattern" tmp448))) ($sc-dispatch tmp448 (quote (any . each-any))))) e443))) (chi-expr151 (lambda (type454 value455 e456 r457 w458 s459 mod460) (if (memv type454 (quote (lexical))) (build-lexical-reference83 (quote value) s459 e456 value455) (if (memv type454 (quote (core core-form))) (value455 e456 r457 w458 s459 mod460) (if (memv type454 (quote (module-ref))) (call-with-values (lambda () (value455 e456)) (lambda (id461 mod462) (build-global-reference86 s459 id461 mod462))) (if (memv type454 (quote (lexical-call))) (chi-application152 (build-lexical-reference83 (quote fun) (source-annotation105 (car e456)) (car e456) value455) e456 r457 w458 s459 mod460) (if (memv type454 (quote (global-call))) (chi-application152 (build-global-reference86 (source-annotation105 (car e456)) (if (syntax-object?98 value455) (syntax-object-expression99 value455) value455) (if (syntax-object?98 value455) (syntax-object-module101 value455) mod460)) e456 r457 w458 s459 mod460) (if (memv type454 (quote (constant))) (build-data92 s459 (strip160 (source-wrap143 e456 w458 s459 mod460) (quote (())))) (if (memv type454 (quote (global))) (build-global-reference86 s459 value455 mod460) (if (memv type454 (quote (call))) (chi-application152 (chi150 (car e456) r457 w458 mod460) e456 r457 w458 s459 mod460) (if (memv type454 (quote (begin-form))) ((lambda (tmp463) ((lambda (tmp464) (if tmp464 (apply (lambda (_465 e1466 e2467) (chi-sequence144 (cons e1466 e2467) r457 w458 s459 mod460)) tmp464) (syntax-violation #f "source expression failed to match any pattern" tmp463))) ($sc-dispatch tmp463 (quote (any any . each-any))))) e456) (if (memv type454 (quote (local-syntax-form))) (chi-local-syntax156 value455 e456 r457 w458 s459 mod460 chi-sequence144) (if (memv type454 (quote (eval-when-form))) ((lambda (tmp469) ((lambda (tmp470) (if tmp470 (apply (lambda (_471 x472 e1473 e2474) (let ((when-list475 (chi-when-list147 e456 x472 w458))) (if (memq (quote eval) when-list475) (chi-sequence144 (cons e1473 e2474) r457 w458 s459 mod460) (chi-void158)))) tmp470) (syntax-violation #f "source expression failed to match any pattern" tmp469))) ($sc-dispatch tmp469 (quote (any each-any any . each-any))))) e456) (if (memv type454 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e456 (wrap142 value455 w458 mod460)) (if (memv type454 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap143 e456 w458 s459 mod460)) (if (memv type454 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap143 e456 w458 s459 mod460)) (syntax-violation #f "unexpected syntax" (source-wrap143 e456 w458 s459 mod460)))))))))))))))))) (chi150 (lambda (e478 r479 w480 mod481) (call-with-values (lambda () (syntax-type148 e478 r479 w480 (source-annotation105 e478) #f mod481 #f)) (lambda (type482 value483 e484 w485 s486 mod487) (chi-expr151 type482 value483 e484 r479 w485 s486 mod487))))) (chi-top149 (lambda (e488 r489 w490 m491 esew492 mod493) (call-with-values (lambda () (syntax-type148 e488 r489 w490 (source-annotation105 e488) #f mod493 #f)) (lambda (type501 value502 e503 w504 s505 mod506) (if (memv type501 (quote (begin-form))) ((lambda (tmp507) ((lambda (tmp508) (if tmp508 (apply (lambda (_509) (chi-void158)) tmp508) ((lambda (tmp510) (if tmp510 (apply (lambda (_511 e1512 e2513) (chi-top-sequence145 (cons e1512 e2513) r489 w504 s505 m491 esew492 mod506)) tmp510) (syntax-violation #f "source expression failed to match any pattern" tmp507))) ($sc-dispatch tmp507 (quote (any any . each-any)))))) ($sc-dispatch tmp507 (quote (any))))) e503) (if (memv type501 (quote (local-syntax-form))) (chi-local-syntax156 value502 e503 r489 w504 s505 mod506 (lambda (body515 r516 w517 s518 mod519) (chi-top-sequence145 body515 r516 w517 s518 m491 esew492 mod519))) (if (memv type501 (quote (eval-when-form))) ((lambda (tmp520) ((lambda (tmp521) (if tmp521 (apply (lambda (_522 x523 e1524 e2525) (let ((when-list526 (chi-when-list147 e503 x523 w504)) (body527 (cons e1524 e2525))) (if (eq? m491 (quote e)) (if (memq (quote eval) when-list526) (chi-top-sequence145 body527 r489 w504 s505 (quote e) (quote (eval)) mod506) (chi-void158)) (if (memq (quote load) when-list526) (if (let ((t530 (memq (quote compile) when-list526))) (if t530 t530 (if (eq? m491 (quote c&e)) (memq (quote eval) when-list526) #f))) (chi-top-sequence145 body527 r489 w504 s505 (quote c&e) (quote (compile load)) mod506) (if (memq m491 (quote (c c&e))) (chi-top-sequence145 body527 r489 w504 s505 (quote c) (quote (load)) mod506) (chi-void158))) (if (let ((t531 (memq (quote compile) when-list526))) (if t531 t531 (if (eq? m491 (quote c&e)) (memq (quote eval) when-list526) #f))) (begin (top-level-eval-hook76 (chi-top-sequence145 body527 r489 w504 s505 (quote e) (quote (eval)) mod506) mod506) (chi-void158)) (chi-void158)))))) tmp521) (syntax-violation #f "source expression failed to match any pattern" tmp520))) ($sc-dispatch tmp520 (quote (any each-any any . each-any))))) e503) (if (memv type501 (quote (define-syntax-form))) (let ((n532 (id-var-name136 value502 w504)) (r533 (macros-only-env110 r489))) (if (memv m491 (quote (c))) (if (memq (quote compile) esew492) (let ((e534 (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)))) (begin (top-level-eval-hook76 e534 mod506) (if (memq (quote load) esew492) e534 (chi-void158)))) (if (memq (quote load) esew492) (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)) (chi-void158))) (if (memv m491 (quote (c&e))) (let ((e535 (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)))) (begin (top-level-eval-hook76 e535 mod506) e535)) (begin (if (memq (quote eval) esew492) (top-level-eval-hook76 (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)) mod506)) (chi-void158))))) (if (memv type501 (quote (define-form))) (let ((n536 (id-var-name136 value502 w504))) (let ((type537 (binding-type106 (lookup111 n536 r489 mod506)))) (if (memv type537 (quote (global core macro module-ref))) (let ((x538 (build-global-definition89 s505 n536 (chi150 e503 r489 w504 mod506)))) (begin (if (eq? m491 (quote c&e)) (top-level-eval-hook76 x538 mod506)) x538)) (if (memv type537 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e503 (wrap142 value502 w504 mod506)) (syntax-violation #f "cannot define keyword at top level" e503 (wrap142 value502 w504 mod506)))))) (let ((x539 (chi-expr151 type501 value502 e503 r489 w504 s505 mod506))) (begin (if (eq? m491 (quote c&e)) (top-level-eval-hook76 x539 mod506)) x539))))))))))) (syntax-type148 (lambda (e540 r541 w542 s543 rib544 mod545 for-car?546) (if (symbol? e540) (let ((n547 (id-var-name136 e540 w542))) (let ((b548 (lookup111 n547 r541 mod545))) (let ((type549 (binding-type106 b548))) (if (memv type549 (quote (lexical))) (values type549 (binding-value107 b548) e540 w542 s543 mod545) (if (memv type549 (quote (global))) (values type549 n547 e540 w542 s543 mod545) (if (memv type549 (quote (macro))) (if for-car?546 (values type549 (binding-value107 b548) e540 w542 s543 mod545) (syntax-type148 (chi-macro153 (binding-value107 b548) e540 r541 w542 rib544 mod545) r541 (quote (())) s543 rib544 mod545 #f)) (values type549 (binding-value107 b548) e540 w542 s543 mod545))))))) (if (pair? e540) (let ((first550 (car e540))) (call-with-values (lambda () (syntax-type148 first550 r541 w542 s543 rib544 mod545 #t)) (lambda (ftype551 fval552 fe553 fw554 fs555 fmod556) (if (memv ftype551 (quote (lexical))) (values (quote lexical-call) fval552 e540 w542 s543 mod545) (if (memv ftype551 (quote (global))) (values (quote global-call) (make-syntax-object97 fval552 w542 fmod556) e540 w542 s543 mod545) (if (memv ftype551 (quote (macro))) (syntax-type148 (chi-macro153 fval552 e540 r541 w542 rib544 mod545) r541 (quote (())) s543 rib544 mod545 for-car?546) (if (memv ftype551 (quote (module-ref))) (call-with-values (lambda () (fval552 e540)) (lambda (sym557 mod558) (syntax-type148 sym557 r541 w542 s543 rib544 mod558 for-car?546))) (if (memv ftype551 (quote (core))) (values (quote core-form) fval552 e540 w542 s543 mod545) (if (memv ftype551 (quote (local-syntax))) (values (quote local-syntax-form) fval552 e540 w542 s543 mod545) (if (memv ftype551 (quote (begin))) (values (quote begin-form) #f e540 w542 s543 mod545) (if (memv ftype551 (quote (eval-when))) (values (quote eval-when-form) #f e540 w542 s543 mod545) (if (memv ftype551 (quote (define))) ((lambda (tmp559) ((lambda (tmp560) (if (if tmp560 (apply (lambda (_561 name562 val563) (id?114 name562)) tmp560) #f) (apply (lambda (_564 name565 val566) (values (quote define-form) name565 val566 w542 s543 mod545)) tmp560) ((lambda (tmp567) (if (if tmp567 (apply (lambda (_568 name569 args570 e1571 e2572) (if (id?114 name569) (valid-bound-ids?139 (lambda-var-list162 args570)) #f)) tmp567) #f) (apply (lambda (_573 name574 args575 e1576 e2577) (values (quote define-form) (wrap142 name574 w542 mod545) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ftype fval fe fw fs fmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod for-car?) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap142 (cons args575 (cons e1576 e2577)) w542 mod545)) (quote (())) s543 mod545)) tmp567) ((lambda (tmp579) (if (if tmp579 (apply (lambda (_580 name581) (id?114 name581)) tmp579) #f) (apply (lambda (_582 name583) (values (quote define-form) (wrap142 name583 w542 mod545) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ftype fval fe fw fs fmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod for-car?) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ftype fval fe fw fs fmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod for-car?) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ftype fval fe fw fs fmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod for-car?) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s543 mod545)) tmp579) (syntax-violation #f "source expression failed to match any pattern" tmp559))) ($sc-dispatch tmp559 (quote (any any)))))) ($sc-dispatch tmp559 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp559 (quote (any any any))))) e540) (if (memv ftype551 (quote (define-syntax))) ((lambda (tmp584) ((lambda (tmp585) (if (if tmp585 (apply (lambda (_586 name587 val588) (id?114 name587)) tmp585) #f) (apply (lambda (_589 name590 val591) (values (quote define-syntax-form) name590 val591 w542 s543 mod545)) tmp585) (syntax-violation #f "source expression failed to match any pattern" tmp584))) ($sc-dispatch tmp584 (quote (any any any))))) e540) (values (quote call) #f e540 w542 s543 mod545)))))))))))))) (if (syntax-object?98 e540) (syntax-type148 (syntax-object-expression99 e540) r541 (join-wraps133 w542 (syntax-object-wrap100 e540)) s543 rib544 (let ((t592 (syntax-object-module101 e540))) (if t592 t592 mod545)) for-car?546) (if (self-evaluating? e540) (values (quote constant) #f e540 w542 s543 mod545) (values (quote other) #f e540 w542 s543 mod545))))))) (chi-when-list147 (lambda (e593 when-list594 w595) (letrec ((f596 (lambda (when-list597 situations598) (if (null? when-list597) situations598 (f596 (cdr when-list597) (cons (let ((x599 (car when-list597))) (if (free-id=?137 x599 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?137 x599 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?137 x599 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e593 (wrap142 x599 w595 #f)))))) situations598)))))) (f596 when-list594 (quote ()))))) (chi-install-global146 (lambda (name600 e601) (build-global-definition89 #f name600 (if (let ((v602 (module-variable (current-module) name600))) (if v602 (if (variable-bound? v602) (if (macro? (variable-ref v602)) (not (eq? (macro-type (variable-ref v602)) (quote syncase-macro))) #f) #f) #f)) (build-application81 #f (build-primref91 #f (quote make-extended-syncase-macro)) (list (build-application81 #f (build-primref91 #f (quote module-ref)) (list (build-application81 #f (build-primref91 #f (quote current-module)) (quote ())) (build-data92 #f name600))) (build-data92 #f (quote macro)) e601)) (build-application81 #f (build-primref91 #f (quote make-syncase-macro)) (list (build-data92 #f (quote macro)) e601)))))) (chi-top-sequence145 (lambda (body603 r604 w605 s606 m607 esew608 mod609) (build-sequence93 s606 (letrec ((dobody610 (lambda (body611 r612 w613 m614 esew615 mod616) (if (null? body611) (quote ()) (let ((first617 (chi-top149 (car body611) r612 w613 m614 esew615 mod616))) (cons first617 (dobody610 (cdr body611) r612 w613 m614 esew615 mod616))))))) (dobody610 body603 r604 w605 m607 esew608 mod609))))) (chi-sequence144 (lambda (body618 r619 w620 s621 mod622) (build-sequence93 s621 (letrec ((dobody623 (lambda (body624 r625 w626 mod627) (if (null? body624) (quote ()) (let ((first628 (chi150 (car body624) r625 w626 mod627))) (cons first628 (dobody623 (cdr body624) r625 w626 mod627))))))) (dobody623 body618 r619 w620 mod622))))) (source-wrap143 (lambda (x629 w630 s631 defmod632) (begin (if (if s631 (pair? x629) #f) (set-source-properties! x629 s631)) (wrap142 x629 w630 defmod632)))) (wrap142 (lambda (x633 w634 defmod635) (if (if (null? (wrap-marks117 w634)) (null? (wrap-subst118 w634)) #f) x633 (if (syntax-object?98 x633) (make-syntax-object97 (syntax-object-expression99 x633) (join-wraps133 w634 (syntax-object-wrap100 x633)) (syntax-object-module101 x633)) (if (null? x633) x633 (make-syntax-object97 x633 w634 defmod635)))))) (bound-id-member?141 (lambda (x636 list637) (if (not (null? list637)) (let ((t638 (bound-id=?138 x636 (car list637)))) (if t638 t638 (bound-id-member?141 x636 (cdr list637)))) #f))) (distinct-bound-ids?140 (lambda (ids639) (letrec ((distinct?640 (lambda (ids641) (let ((t642 (null? ids641))) (if t642 t642 (if (not (bound-id-member?141 (car ids641) (cdr ids641))) (distinct?640 (cdr ids641)) #f)))))) (distinct?640 ids639)))) (valid-bound-ids?139 (lambda (ids643) (if (letrec ((all-ids?644 (lambda (ids645) (let ((t646 (null? ids645))) (if t646 t646 (if (id?114 (car ids645)) (all-ids?644 (cdr ids645)) #f)))))) (all-ids?644 ids643)) (distinct-bound-ids?140 ids643) #f))) (bound-id=?138 (lambda (i647 j648) (if (if (syntax-object?98 i647) (syntax-object?98 j648) #f) (if (eq? (syntax-object-expression99 i647) (syntax-object-expression99 j648)) (same-marks?135 (wrap-marks117 (syntax-object-wrap100 i647)) (wrap-marks117 (syntax-object-wrap100 j648))) #f) (eq? i647 j648)))) (free-id=?137 (lambda (i649 j650) (if (eq? (let ((x651 i649)) (if (syntax-object?98 x651) (syntax-object-expression99 x651) x651)) (let ((x652 j650)) (if (syntax-object?98 x652) (syntax-object-expression99 x652) x652))) (eq? (id-var-name136 i649 (quote (()))) (id-var-name136 j650 (quote (())))) #f))) (id-var-name136 (lambda (id653 w654) (letrec ((search-vector-rib657 (lambda (sym663 subst664 marks665 symnames666 ribcage667) (let ((n668 (vector-length symnames666))) (letrec ((f669 (lambda (i670) (if (fx=74 i670 n668) (search655 sym663 (cdr subst664) marks665) (if (if (eq? (vector-ref symnames666 i670) sym663) (same-marks?135 marks665 (vector-ref (ribcage-marks124 ribcage667) i670)) #f) (values (vector-ref (ribcage-labels125 ribcage667) i670) marks665) (f669 (fx+72 i670 1))))))) (f669 0))))) (search-list-rib656 (lambda (sym671 subst672 marks673 symnames674 ribcage675) (letrec ((f676 (lambda (symnames677 i678) (if (null? symnames677) (search655 sym671 (cdr subst672) marks673) (if (if (eq? (car symnames677) sym671) (same-marks?135 marks673 (list-ref (ribcage-marks124 ribcage675) i678)) #f) (values (list-ref (ribcage-labels125 ribcage675) i678) marks673) (f676 (cdr symnames677) (fx+72 i678 1))))))) (f676 symnames674 0)))) (search655 (lambda (sym679 subst680 marks681) (if (null? subst680) (values #f marks681) (let ((fst682 (car subst680))) (if (eq? fst682 (quote shift)) (search655 sym679 (cdr subst680) (cdr marks681)) (let ((symnames683 (ribcage-symnames123 fst682))) (if (vector? symnames683) (search-vector-rib657 sym679 subst680 marks681 symnames683 fst682) (search-list-rib656 sym679 subst680 marks681 symnames683 fst682))))))))) (if (symbol? id653) (let ((t684 (call-with-values (lambda () (search655 id653 (wrap-subst118 w654) (wrap-marks117 w654))) (lambda (x686 . ignore685) x686)))) (if t684 t684 id653)) (if (syntax-object?98 id653) (let ((id687 (syntax-object-expression99 id653)) (w1688 (syntax-object-wrap100 id653))) (let ((marks689 (join-marks134 (wrap-marks117 w654) (wrap-marks117 w1688)))) (call-with-values (lambda () (search655 id687 (wrap-subst118 w654) marks689)) (lambda (new-id690 marks691) (let ((t692 new-id690)) (if t692 t692 (let ((t693 (call-with-values (lambda () (search655 id687 (wrap-subst118 w1688) marks691)) (lambda (x695 . ignore694) x695)))) (if t693 t693 id687)))))))) (syntax-violation (quote id-var-name) "invalid id" id653)))))) (same-marks?135 (lambda (x696 y697) (let ((t698 (eq? x696 y697))) (if t698 t698 (if (not (null? x696)) (if (not (null? y697)) (if (eq? (car x696) (car y697)) (same-marks?135 (cdr x696) (cdr y697)) #f) #f) #f))))) (join-marks134 (lambda (m1699 m2700) (smart-append132 m1699 m2700))) (join-wraps133 (lambda (w1701 w2702) (let ((m1703 (wrap-marks117 w1701)) (s1704 (wrap-subst118 w1701))) (if (null? m1703) (if (null? s1704) w2702 (make-wrap116 (wrap-marks117 w2702) (smart-append132 s1704 (wrap-subst118 w2702)))) (make-wrap116 (smart-append132 m1703 (wrap-marks117 w2702)) (smart-append132 s1704 (wrap-subst118 w2702))))))) (smart-append132 (lambda (m1705 m2706) (if (null? m2706) m1705 (append m1705 m2706)))) (make-binding-wrap131 (lambda (ids707 labels708 w709) (if (null? ids707) w709 (make-wrap116 (wrap-marks117 w709) (cons (let ((labelvec710 (list->vector labels708))) (let ((n711 (vector-length labelvec710))) (let ((symnamevec712 (make-vector n711)) (marksvec713 (make-vector n711))) (begin (letrec ((f714 (lambda (ids715 i716) (if (not (null? ids715)) (call-with-values (lambda () (id-sym-name&marks115 (car ids715) w709)) (lambda (symname717 marks718) (begin (vector-set! symnamevec712 i716 symname717) (vector-set! marksvec713 i716 marks718) (f714 (cdr ids715) (fx+72 i716 1))))))))) (f714 ids707 0)) (make-ribcage121 symnamevec712 marksvec713 labelvec710))))) (wrap-subst118 w709)))))) (extend-ribcage!130 (lambda (ribcage719 id720 label721) (begin (set-ribcage-symnames!126 ribcage719 (cons (syntax-object-expression99 id720) (ribcage-symnames123 ribcage719))) (set-ribcage-marks!127 ribcage719 (cons (wrap-marks117 (syntax-object-wrap100 id720)) (ribcage-marks124 ribcage719))) (set-ribcage-labels!128 ribcage719 (cons label721 (ribcage-labels125 ribcage719)))))) (anti-mark129 (lambda (w722) (make-wrap116 (cons #f (wrap-marks117 w722)) (cons (quote shift) (wrap-subst118 w722))))) (set-ribcage-labels!128 (lambda (x723 update724) (vector-set! x723 3 update724))) (set-ribcage-marks!127 (lambda (x725 update726) (vector-set! x725 2 update726))) (set-ribcage-symnames!126 (lambda (x727 update728) (vector-set! x727 1 update728))) (ribcage-labels125 (lambda (x729) (vector-ref x729 3))) (ribcage-marks124 (lambda (x730) (vector-ref x730 2))) (ribcage-symnames123 (lambda (x731) (vector-ref x731 1))) (ribcage?122 (lambda (x732) (if (vector? x732) (if (= (vector-length x732) 4) (eq? (vector-ref x732 0) (quote ribcage)) #f) #f))) (make-ribcage121 (lambda (symnames733 marks734 labels735) (vector (quote ribcage) symnames733 marks734 labels735))) (gen-labels120 (lambda (ls736) (if (null? ls736) (quote ()) (cons (gen-label119) (gen-labels120 (cdr ls736)))))) (gen-label119 (lambda () (string #\i))) (wrap-subst118 cdr) (wrap-marks117 car) (make-wrap116 cons) (id-sym-name&marks115 (lambda (x737 w738) (if (syntax-object?98 x737) (values (syntax-object-expression99 x737) (join-marks134 (wrap-marks117 w738) (wrap-marks117 (syntax-object-wrap100 x737)))) (values x737 (wrap-marks117 w738))))) (id?114 (lambda (x739) (if (symbol? x739) #t (if (syntax-object?98 x739) (symbol? (syntax-object-expression99 x739)) #f)))) (nonsymbol-id?113 (lambda (x740) (if (syntax-object?98 x740) (symbol? (syntax-object-expression99 x740)) #f))) (global-extend112 (lambda (type741 sym742 val743) (put-global-definition-hook78 sym742 type741 val743))) (lookup111 (lambda (x744 r745 mod746) (let ((t747 (assq x744 r745))) (if t747 (cdr t747) (if (symbol? x744) (let ((t748 (get-global-definition-hook79 x744 mod746))) (if t748 t748 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env110 (lambda (r749) (if (null? r749) (quote ()) (let ((a750 (car r749))) (if (eq? (cadr a750) (quote macro)) (cons a750 (macros-only-env110 (cdr r749))) (macros-only-env110 (cdr r749))))))) (extend-var-env109 (lambda (labels751 vars752 r753) (if (null? labels751) r753 (extend-var-env109 (cdr labels751) (cdr vars752) (cons (cons (car labels751) (cons (quote lexical) (car vars752))) r753))))) (extend-env108 (lambda (labels754 bindings755 r756) (if (null? labels754) r756 (extend-env108 (cdr labels754) (cdr bindings755) (cons (cons (car labels754) (car bindings755)) r756))))) (binding-value107 cdr) (binding-type106 car) (source-annotation105 (lambda (x757) (if (syntax-object?98 x757) (source-annotation105 (syntax-object-expression99 x757)) (if (pair? x757) (let ((props758 (source-properties x757))) (if (pair? props758) props758 #f)) #f)))) (set-syntax-object-module!104 (lambda (x759 update760) (vector-set! x759 3 update760))) (set-syntax-object-wrap!103 (lambda (x761 update762) (vector-set! x761 2 update762))) (set-syntax-object-expression!102 (lambda (x763 update764) (vector-set! x763 1 update764))) (syntax-object-module101 (lambda (x765) (vector-ref x765 3))) (syntax-object-wrap100 (lambda (x766) (vector-ref x766 2))) (syntax-object-expression99 (lambda (x767) (vector-ref x767 1))) (syntax-object?98 (lambda (x768) (if (vector? x768) (if (= (vector-length x768) 4) (eq? (vector-ref x768 0) (quote syntax-object)) #f) #f))) (make-syntax-object97 (lambda (expression769 wrap770 module771) (vector (quote syntax-object) expression769 wrap770 module771))) (build-letrec96 (lambda (src772 ids773 vars774 val-exps775 body-exp776) (if (null? vars774) body-exp776 (let ((atom-key777 (fluid-ref *mode*71))) (if (memv atom-key777 (quote (c))) (begin (for-each maybe-name-value!88 ids773 val-exps775) ((@ (language tree-il) make-letrec) src772 ids773 vars774 val-exps775 body-exp776)) (list (quote letrec) (map list vars774 val-exps775) body-exp776)))))) (build-named-let95 (lambda (src778 ids779 vars780 val-exps781 body-exp782) (let ((f783 (car vars780)) (f-name784 (car ids779)) (vars785 (cdr vars780)) (ids786 (cdr ids779))) (let ((atom-key787 (fluid-ref *mode*71))) (if (memv atom-key787 (quote (c))) (let ((proc788 (build-lambda90 src778 ids786 vars785 #f body-exp782))) (begin (maybe-name-value!88 f-name784 proc788) (for-each maybe-name-value!88 ids786 val-exps781) ((@ (language tree-il) make-letrec) src778 (list f-name784) (list f783) (list proc788) (build-application81 src778 (build-lexical-reference83 (quote fun) src778 f-name784 f783) val-exps781)))) (list (quote let) f783 (map list vars785 val-exps781) body-exp782)))))) (build-let94 (lambda (src789 ids790 vars791 val-exps792 body-exp793) (if (null? vars791) body-exp793 (let ((atom-key794 (fluid-ref *mode*71))) (if (memv atom-key794 (quote (c))) (begin (for-each maybe-name-value!88 ids790 val-exps792) ((@ (language tree-il) make-let) src789 ids790 vars791 val-exps792 body-exp793)) (list (quote let) (map list vars791 val-exps792) body-exp793)))))) (build-sequence93 (lambda (src795 exps796) (if (null? (cdr exps796)) (car exps796) (let ((atom-key797 (fluid-ref *mode*71))) (if (memv atom-key797 (quote (c))) ((@ (language tree-il) make-sequence) src795 exps796) (cons (quote begin) exps796)))))) (build-data92 (lambda (src798 exp799) (let ((atom-key800 (fluid-ref *mode*71))) (if (memv atom-key800 (quote (c))) ((@ (language tree-il) make-const) src798 exp799) (if (if (self-evaluating? exp799) (not (vector? exp799)) #f) exp799 (list (quote quote) exp799)))))) (build-primref91 (lambda (src801 name802) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key803 (fluid-ref *mode*71))) (if (memv atom-key803 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src801 name802) name802)) (let ((atom-key804 (fluid-ref *mode*71))) (if (memv atom-key804 (quote (c))) ((@ (language tree-il) make-module-ref) src801 (quote (guile)) name802 #f) (list (quote @@) (quote (guile)) name802)))))) (build-lambda90 (lambda (src805 ids806 vars807 docstring808 exp809) (let ((atom-key810 (fluid-ref *mode*71))) (if (memv atom-key810 (quote (c))) ((@ (language tree-il) make-lambda) src805 ids806 vars807 (if docstring808 (list (cons (quote documentation) docstring808)) (quote ())) exp809) (cons (quote lambda) (cons vars807 (append (if docstring808 (list docstring808) (quote ())) (list exp809)))))))) (build-global-definition89 (lambda (source811 var812 exp813) (let ((atom-key814 (fluid-ref *mode*71))) (if (memv atom-key814 (quote (c))) (begin (maybe-name-value!88 var812 exp813) ((@ (language tree-il) make-toplevel-define) source811 var812 exp813)) (list (quote define) var812 exp813))))) (maybe-name-value!88 (lambda (name815 val816) (if ((@ (language tree-il) lambda?) val816) (let ((meta817 ((@ (language tree-il) lambda-meta) val816))) (if (not (assq (quote name) meta817)) ((setter (@ (language tree-il) lambda-meta)) val816 (acons (quote name) name815 meta817))))))) (build-global-assignment87 (lambda (source818 var819 exp820 mod821) (analyze-variable85 mod821 var819 (lambda (mod822 var823 public?824) (let ((atom-key825 (fluid-ref *mode*71))) (if (memv atom-key825 (quote (c))) ((@ (language tree-il) make-module-set) source818 mod822 var823 public?824 exp820) (list (quote set!) (list (if public?824 (quote @) (quote @@)) mod822 var823) exp820)))) (lambda (var826) (let ((atom-key827 (fluid-ref *mode*71))) (if (memv atom-key827 (quote (c))) ((@ (language tree-il) make-toplevel-set) source818 var826 exp820) (list (quote set!) var826 exp820))))))) (build-global-reference86 (lambda (source828 var829 mod830) (analyze-variable85 mod830 var829 (lambda (mod831 var832 public?833) (let ((atom-key834 (fluid-ref *mode*71))) (if (memv atom-key834 (quote (c))) ((@ (language tree-il) make-module-ref) source828 mod831 var832 public?833) (list (if public?833 (quote @) (quote @@)) mod831 var832)))) (lambda (var835) (let ((atom-key836 (fluid-ref *mode*71))) (if (memv atom-key836 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source828 var835) var835)))))) (analyze-variable85 (lambda (mod837 var838 modref-cont839 bare-cont840) (if (not mod837) (bare-cont840 var838) (let ((kind841 (car mod837)) (mod842 (cdr mod837))) (if (memv kind841 (quote (public))) (modref-cont839 mod842 var838 #t) (if (memv kind841 (quote (private))) (if (not (equal? mod842 (module-name (current-module)))) (modref-cont839 mod842 var838 #f) (bare-cont840 var838)) (if (memv kind841 (quote (bare))) (bare-cont840 var838) (if (memv kind841 (quote (hygiene))) (if (if (not (equal? mod842 (module-name (current-module)))) (module-variable (resolve-module mod842) var838) #f) (modref-cont839 mod842 var838 #f) (bare-cont840 var838)) (syntax-violation #f "bad module kind" var838 mod842))))))))) (build-lexical-assignment84 (lambda (source843 name844 var845 exp846) (let ((atom-key847 (fluid-ref *mode*71))) (if (memv atom-key847 (quote (c))) ((@ (language tree-il) make-lexical-set) source843 name844 var845 exp846) (list (quote set!) var845 exp846))))) (build-lexical-reference83 (lambda (type848 source849 name850 var851) (let ((atom-key852 (fluid-ref *mode*71))) (if (memv atom-key852 (quote (c))) ((@ (language tree-il) make-lexical-ref) source849 name850 var851) var851)))) (build-conditional82 (lambda (source853 test-exp854 then-exp855 else-exp856) (let ((atom-key857 (fluid-ref *mode*71))) (if (memv atom-key857 (quote (c))) ((@ (language tree-il) make-conditional) source853 test-exp854 then-exp855 else-exp856) (if (equal? else-exp856 (quote (if #f #f))) (list (quote if) test-exp854 then-exp855) (list (quote if) test-exp854 then-exp855 else-exp856)))))) (build-application81 (lambda (source858 fun-exp859 arg-exps860) (let ((atom-key861 (fluid-ref *mode*71))) (if (memv atom-key861 (quote (c))) ((@ (language tree-il) make-application) source858 fun-exp859 arg-exps860) (cons fun-exp859 arg-exps860))))) (build-void80 (lambda (source862) (let ((atom-key863 (fluid-ref *mode*71))) (if (memv atom-key863 (quote (c))) ((@ (language tree-il) make-void) source862) (quote (if #f #f)))))) (get-global-definition-hook79 (lambda (symbol864 module865) (begin (if (if (not module865) (current-module) #f) (warn "module system is booted, we should have a module" symbol864)) (let ((v866 (module-variable (if module865 (resolve-module (cdr module865)) (current-module)) symbol864))) (if v866 (if (variable-bound? v866) (let ((val867 (variable-ref v866))) (if (macro? val867) (if (syncase-macro-type val867) (cons (syncase-macro-type val867) (syncase-macro-binding val867)) #f) #f)) #f) #f))))) (put-global-definition-hook78 (lambda (symbol868 type869 val870) (let ((existing871 (let ((v872 (module-variable (current-module) symbol868))) (if v872 (if (variable-bound? v872) (let ((val873 (variable-ref v872))) (if (macro? val873) (if (not (syncase-macro-type val873)) val873 #f) #f)) #f) #f)))) (module-define! (current-module) symbol868 (if existing871 (make-extended-syncase-macro existing871 type869 val870) (make-syncase-macro type869 val870)))))) (local-eval-hook77 (lambda (x874 mod875) (primitive-eval (list noexpand70 (let ((atom-key876 (fluid-ref *mode*71))) (if (memv atom-key876 (quote (c))) ((@ (language tree-il) tree-il->scheme) x874) x874)))))) (top-level-eval-hook76 (lambda (x877 mod878) (primitive-eval (list noexpand70 (let ((atom-key879 (fluid-ref *mode*71))) (if (memv atom-key879 (quote (c))) ((@ (language tree-il) tree-il->scheme) x877) x877)))))) (fx<75 <) (fx=74 =) (fx-73 -) (fx+72 +) (*mode*71 (make-fluid)) (noexpand70 "noexpand")) (begin (global-extend112 (quote local-syntax) (quote letrec-syntax) #t) (global-extend112 (quote local-syntax) (quote let-syntax) #f) (global-extend112 (quote core) (quote fluid-let-syntax) (lambda (e880 r881 w882 s883 mod884) ((lambda (tmp885) ((lambda (tmp886) (if (if tmp886 (apply (lambda (_887 var888 val889 e1890 e2891) (valid-bound-ids?139 var888)) tmp886) #f) (apply (lambda (_893 var894 val895 e1896 e2897) (let ((names898 (map (lambda (x899) (id-var-name136 x899 w882)) var894))) (begin (for-each (lambda (id901 n902) (let ((atom-key903 (binding-type106 (lookup111 n902 r881 mod884)))) (if (memv atom-key903 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e880 (source-wrap143 id901 w882 s883 mod884))))) var894 names898) (chi-body154 (cons e1896 e2897) (source-wrap143 e880 w882 s883 mod884) (extend-env108 names898 (let ((trans-r906 (macros-only-env110 r881))) (map (lambda (x907) (cons (quote macro) (eval-local-transformer157 (chi150 x907 trans-r906 w882 mod884) mod884))) val895)) r881) w882 mod884)))) tmp886) ((lambda (_909) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap143 e880 w882 s883 mod884))) tmp885))) ($sc-dispatch tmp885 (quote (any #(each (any any)) any . each-any))))) e880))) (global-extend112 (quote core) (quote quote) (lambda (e910 r911 w912 s913 mod914) ((lambda (tmp915) ((lambda (tmp916) (if tmp916 (apply (lambda (_917 e918) (build-data92 s913 (strip160 e918 w912))) tmp916) ((lambda (_919) (syntax-violation (quote quote) "bad syntax" (source-wrap143 e910 w912 s913 mod914))) tmp915))) ($sc-dispatch tmp915 (quote (any any))))) e910))) (global-extend112 (quote core) (quote syntax) (letrec ((regen927 (lambda (x928) (let ((atom-key929 (car x928))) (if (memv atom-key929 (quote (ref))) (build-lexical-reference83 (quote value) #f (cadr x928) (cadr x928)) (if (memv atom-key929 (quote (primitive))) (build-primref91 #f (cadr x928)) (if (memv atom-key929 (quote (quote))) (build-data92 #f (cadr x928)) (if (memv atom-key929 (quote (lambda))) (build-lambda90 #f (cadr x928) (cadr x928) #f (regen927 (caddr x928))) (build-application81 #f (build-primref91 #f (car x928)) (map regen927 (cdr x928)))))))))) (gen-vector926 (lambda (x930) (if (eq? (car x930) (quote list)) (cons (quote vector) (cdr x930)) (if (eq? (car x930) (quote quote)) (list (quote quote) (list->vector (cadr x930))) (list (quote list->vector) x930))))) (gen-append925 (lambda (x931 y932) (if (equal? y932 (quote (quote ()))) x931 (list (quote append) x931 y932)))) (gen-cons924 (lambda (x933 y934) (let ((atom-key935 (car y934))) (if (memv atom-key935 (quote (quote))) (if (eq? (car x933) (quote quote)) (list (quote quote) (cons (cadr x933) (cadr y934))) (if (eq? (cadr y934) (quote ())) (list (quote list) x933) (list (quote cons) x933 y934))) (if (memv atom-key935 (quote (list))) (cons (quote list) (cons x933 (cdr y934))) (list (quote cons) x933 y934)))))) (gen-map923 (lambda (e936 map-env937) (let ((formals938 (map cdr map-env937)) (actuals939 (map (lambda (x940) (list (quote ref) (car x940))) map-env937))) (if (eq? (car e936) (quote ref)) (car actuals939) (if (and-map (lambda (x941) (if (eq? (car x941) (quote ref)) (memq (cadr x941) formals938) #f)) (cdr e936)) (cons (quote map) (cons (list (quote primitive) (car e936)) (map (let ((r942 (map cons formals938 actuals939))) (lambda (x943) (cdr (assq (cadr x943) r942)))) (cdr e936)))) (cons (quote map) (cons (list (quote lambda) formals938 e936) actuals939))))))) (gen-mappend922 (lambda (e944 map-env945) (list (quote apply) (quote (primitive append)) (gen-map923 e944 map-env945)))) (gen-ref921 (lambda (src946 var947 level948 maps949) (if (fx=74 level948 0) (values var947 maps949) (if (null? maps949) (syntax-violation (quote syntax) "missing ellipsis" src946) (call-with-values (lambda () (gen-ref921 src946 var947 (fx-73 level948 1) (cdr maps949))) (lambda (outer-var950 outer-maps951) (let ((b952 (assq outer-var950 (car maps949)))) (if b952 (values (cdr b952) maps949) (let ((inner-var953 (gen-var161 (quote tmp)))) (values inner-var953 (cons (cons (cons outer-var950 inner-var953) (car maps949)) outer-maps951))))))))))) (gen-syntax920 (lambda (src954 e955 r956 maps957 ellipsis?958 mod959) (if (id?114 e955) (let ((label960 (id-var-name136 e955 (quote (()))))) (let ((b961 (lookup111 label960 r956 mod959))) (if (eq? (binding-type106 b961) (quote syntax)) (call-with-values (lambda () (let ((var.lev962 (binding-value107 b961))) (gen-ref921 src954 (car var.lev962) (cdr var.lev962) maps957))) (lambda (var963 maps964) (values (list (quote ref) var963) maps964))) (if (ellipsis?958 e955) (syntax-violation (quote syntax) "misplaced ellipsis" src954) (values (list (quote quote) e955) maps957))))) ((lambda (tmp965) ((lambda (tmp966) (if (if tmp966 (apply (lambda (dots967 e968) (ellipsis?958 dots967)) tmp966) #f) (apply (lambda (dots969 e970) (gen-syntax920 src954 e970 r956 maps957 (lambda (x971) #f) mod959)) tmp966) ((lambda (tmp972) (if (if tmp972 (apply (lambda (x973 dots974 y975) (ellipsis?958 dots974)) tmp972) #f) (apply (lambda (x976 dots977 y978) (letrec ((f979 (lambda (y980 k981) ((lambda (tmp985) ((lambda (tmp986) (if (if tmp986 (apply (lambda (dots987 y988) (ellipsis?958 dots987)) tmp986) #f) (apply (lambda (dots989 y990) (f979 y990 (lambda (maps991) (call-with-values (lambda () (k981 (cons (quote ()) maps991))) (lambda (x992 maps993) (if (null? (car maps993)) (syntax-violation (quote syntax) "extra ellipsis" src954) (values (gen-mappend922 x992 (car maps993)) (cdr maps993)))))))) tmp986) ((lambda (_994) (call-with-values (lambda () (gen-syntax920 src954 y980 r956 maps957 ellipsis?958 mod959)) (lambda (y995 maps996) (call-with-values (lambda () (k981 maps996)) (lambda (x997 maps998) (values (gen-append925 x997 y995) maps998)))))) tmp985))) ($sc-dispatch tmp985 (quote (any . any))))) y980)))) (f979 y978 (lambda (maps982) (call-with-values (lambda () (gen-syntax920 src954 x976 r956 (cons (quote ()) maps982) ellipsis?958 mod959)) (lambda (x983 maps984) (if (null? (car maps984)) (syntax-violation (quote syntax) "extra ellipsis" src954) (values (gen-map923 x983 (car maps984)) (cdr maps984))))))))) tmp972) ((lambda (tmp999) (if tmp999 (apply (lambda (x1000 y1001) (call-with-values (lambda () (gen-syntax920 src954 x1000 r956 maps957 ellipsis?958 mod959)) (lambda (x1002 maps1003) (call-with-values (lambda () (gen-syntax920 src954 y1001 r956 maps1003 ellipsis?958 mod959)) (lambda (y1004 maps1005) (values (gen-cons924 x1002 y1004) maps1005)))))) tmp999) ((lambda (tmp1006) (if tmp1006 (apply (lambda (e11007 e21008) (call-with-values (lambda () (gen-syntax920 src954 (cons e11007 e21008) r956 maps957 ellipsis?958 mod959)) (lambda (e1010 maps1011) (values (gen-vector926 e1010) maps1011)))) tmp1006) ((lambda (_1012) (values (list (quote quote) e955) maps957)) tmp965))) ($sc-dispatch tmp965 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp965 (quote (any . any)))))) ($sc-dispatch tmp965 (quote (any any . any)))))) ($sc-dispatch tmp965 (quote (any any))))) e955))))) (lambda (e1013 r1014 w1015 s1016 mod1017) (let ((e1018 (source-wrap143 e1013 w1015 s1016 mod1017))) ((lambda (tmp1019) ((lambda (tmp1020) (if tmp1020 (apply (lambda (_1021 x1022) (call-with-values (lambda () (gen-syntax920 e1018 x1022 r1014 (quote ()) ellipsis?159 mod1017)) (lambda (e1023 maps1024) (regen927 e1023)))) tmp1020) ((lambda (_1025) (syntax-violation (quote syntax) "bad `syntax' form" e1018)) tmp1019))) ($sc-dispatch tmp1019 (quote (any any))))) e1018))))) (global-extend112 (quote core) (quote lambda) (lambda (e1026 r1027 w1028 s1029 mod1030) ((lambda (tmp1031) ((lambda (tmp1032) (if tmp1032 (apply (lambda (_1033 c1034) (chi-lambda-clause155 (source-wrap143 e1026 w1028 s1029 mod1030) #f c1034 r1027 w1028 mod1030 (lambda (names1035 vars1036 docstring1037 body1038) (build-lambda90 s1029 names1035 vars1036 docstring1037 body1038)))) tmp1032) (syntax-violation #f "source expression failed to match any pattern" tmp1031))) ($sc-dispatch tmp1031 (quote (any . any))))) e1026))) (global-extend112 (quote core) (quote let) (letrec ((chi-let1039 (lambda (e1040 r1041 w1042 s1043 mod1044 constructor1045 ids1046 vals1047 exps1048) (if (not (valid-bound-ids?139 ids1046)) (syntax-violation (quote let) "duplicate bound variable" e1040) (let ((labels1049 (gen-labels120 ids1046)) (new-vars1050 (map gen-var161 ids1046))) (let ((nw1051 (make-binding-wrap131 ids1046 labels1049 w1042)) (nr1052 (extend-var-env109 labels1049 new-vars1050 r1041))) (constructor1045 s1043 (map syntax->datum ids1046) new-vars1050 (map (lambda (x1053) (chi150 x1053 r1041 w1042 mod1044)) vals1047) (chi-body154 exps1048 (source-wrap143 e1040 nw1051 s1043 mod1044) nr1052 nw1051 mod1044)))))))) (lambda (e1054 r1055 w1056 s1057 mod1058) ((lambda (tmp1059) ((lambda (tmp1060) (if (if tmp1060 (apply (lambda (_1061 id1062 val1063 e11064 e21065) (and-map id?114 id1062)) tmp1060) #f) (apply (lambda (_1067 id1068 val1069 e11070 e21071) (chi-let1039 e1054 r1055 w1056 s1057 mod1058 build-let94 id1068 val1069 (cons e11070 e21071))) tmp1060) ((lambda (tmp1075) (if (if tmp1075 (apply (lambda (_1076 f1077 id1078 val1079 e11080 e21081) (if (id?114 f1077) (and-map id?114 id1078) #f)) tmp1075) #f) (apply (lambda (_1083 f1084 id1085 val1086 e11087 e21088) (chi-let1039 e1054 r1055 w1056 s1057 mod1058 build-named-let95 (cons f1084 id1085) val1086 (cons e11087 e21088))) tmp1075) ((lambda (_1092) (syntax-violation (quote let) "bad let" (source-wrap143 e1054 w1056 s1057 mod1058))) tmp1059))) ($sc-dispatch tmp1059 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1059 (quote (any #(each (any any)) any . each-any))))) e1054)))) (global-extend112 (quote core) (quote letrec) (lambda (e1093 r1094 w1095 s1096 mod1097) ((lambda (tmp1098) ((lambda (tmp1099) (if (if tmp1099 (apply (lambda (_1100 id1101 val1102 e11103 e21104) (and-map id?114 id1101)) tmp1099) #f) (apply (lambda (_1106 id1107 val1108 e11109 e21110) (let ((ids1111 id1107)) (if (not (valid-bound-ids?139 ids1111)) (syntax-violation (quote letrec) "duplicate bound variable" e1093) (let ((labels1113 (gen-labels120 ids1111)) (new-vars1114 (map gen-var161 ids1111))) (let ((w1115 (make-binding-wrap131 ids1111 labels1113 w1095)) (r1116 (extend-var-env109 labels1113 new-vars1114 r1094))) (build-letrec96 s1096 (map syntax->datum ids1111) new-vars1114 (map (lambda (x1117) (chi150 x1117 r1116 w1115 mod1097)) val1108) (chi-body154 (cons e11109 e21110) (source-wrap143 e1093 w1115 s1096 mod1097) r1116 w1115 mod1097))))))) tmp1099) ((lambda (_1120) (syntax-violation (quote letrec) "bad letrec" (source-wrap143 e1093 w1095 s1096 mod1097))) tmp1098))) ($sc-dispatch tmp1098 (quote (any #(each (any any)) any . each-any))))) e1093))) (global-extend112 (quote core) (quote set!) (lambda (e1121 r1122 w1123 s1124 mod1125) ((lambda (tmp1126) ((lambda (tmp1127) (if (if tmp1127 (apply (lambda (_1128 id1129 val1130) (id?114 id1129)) tmp1127) #f) (apply (lambda (_1131 id1132 val1133) (let ((val1134 (chi150 val1133 r1122 w1123 mod1125)) (n1135 (id-var-name136 id1132 w1123))) (let ((b1136 (lookup111 n1135 r1122 mod1125))) (let ((atom-key1137 (binding-type106 b1136))) (if (memv atom-key1137 (quote (lexical))) (build-lexical-assignment84 s1124 (syntax->datum id1132) (binding-value107 b1136) val1134) (if (memv atom-key1137 (quote (global))) (build-global-assignment87 s1124 n1135 val1134 mod1125) (if (memv atom-key1137 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap142 id1132 w1123 mod1125)) (syntax-violation (quote set!) "bad set!" (source-wrap143 e1121 w1123 s1124 mod1125))))))))) tmp1127) ((lambda (tmp1138) (if tmp1138 (apply (lambda (_1139 head1140 tail1141 val1142) (call-with-values (lambda () (syntax-type148 head1140 r1122 (quote (())) #f #f mod1125 #t)) (lambda (type1143 value1144 ee1145 ww1146 ss1147 modmod1148) (if (memv type1143 (quote (module-ref))) (let ((val1149 (chi150 val1142 r1122 w1123 mod1125))) (call-with-values (lambda () (value1144 (cons head1140 tail1141))) (lambda (id1151 mod1152) (build-global-assignment87 s1124 id1151 val1149 mod1152)))) (build-application81 s1124 (chi150 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head1140) r1122 w1123 mod1125) (map (lambda (e1153) (chi150 e1153 r1122 w1123 mod1125)) (append tail1141 (list val1142)))))))) tmp1138) ((lambda (_1155) (syntax-violation (quote set!) "bad set!" (source-wrap143 e1121 w1123 s1124 mod1125))) tmp1126))) ($sc-dispatch tmp1126 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1126 (quote (any any any))))) e1121))) (global-extend112 (quote module-ref) (quote @) (lambda (e1156) ((lambda (tmp1157) ((lambda (tmp1158) (if (if tmp1158 (apply (lambda (_1159 mod1160 id1161) (if (and-map id?114 mod1160) (id?114 id1161) #f)) tmp1158) #f) (apply (lambda (_1163 mod1164 id1165) (values (syntax->datum id1165) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1164)))) tmp1158) (syntax-violation #f "source expression failed to match any pattern" tmp1157))) ($sc-dispatch tmp1157 (quote (any each-any any))))) e1156))) (global-extend112 (quote module-ref) (quote @@) (lambda (e1167) ((lambda (tmp1168) ((lambda (tmp1169) (if (if tmp1169 (apply (lambda (_1170 mod1171 id1172) (if (and-map id?114 mod1171) (id?114 id1172) #f)) tmp1169) #f) (apply (lambda (_1174 mod1175 id1176) (values (syntax->datum id1176) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1175)))) tmp1169) (syntax-violation #f "source expression failed to match any pattern" tmp1168))) ($sc-dispatch tmp1168 (quote (any each-any any))))) e1167))) (global-extend112 (quote core) (quote if) (lambda (e1178 r1179 w1180 s1181 mod1182) ((lambda (tmp1183) ((lambda (tmp1184) (if tmp1184 (apply (lambda (_1185 test1186 then1187) (build-conditional82 s1181 (chi150 test1186 r1179 w1180 mod1182) (chi150 then1187 r1179 w1180 mod1182) (build-void80 #f))) tmp1184) ((lambda (tmp1188) (if tmp1188 (apply (lambda (_1189 test1190 then1191 else1192) (build-conditional82 s1181 (chi150 test1190 r1179 w1180 mod1182) (chi150 then1191 r1179 w1180 mod1182) (chi150 else1192 r1179 w1180 mod1182))) tmp1188) (syntax-violation #f "source expression failed to match any pattern" tmp1183))) ($sc-dispatch tmp1183 (quote (any any any any)))))) ($sc-dispatch tmp1183 (quote (any any any))))) e1178))) (global-extend112 (quote begin) (quote begin) (quote ())) (global-extend112 (quote define) (quote define) (quote ())) (global-extend112 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend112 (quote eval-when) (quote eval-when) (quote ())) (global-extend112 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1196 (lambda (x1197 keys1198 clauses1199 r1200 mod1201) (if (null? clauses1199) (build-application81 #f (build-primref91 #f (quote syntax-violation)) (list (build-data92 #f #f) (build-data92 #f "source expression failed to match any pattern") x1197)) ((lambda (tmp1202) ((lambda (tmp1203) (if tmp1203 (apply (lambda (pat1204 exp1205) (if (if (id?114 pat1204) (and-map (lambda (x1206) (not (free-id=?137 pat1204 x1206))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys1198)) #f) (let ((labels1207 (list (gen-label119))) (var1208 (gen-var161 pat1204))) (build-application81 #f (build-lambda90 #f (list (syntax->datum pat1204)) (list var1208) #f (chi150 exp1205 (extend-env108 labels1207 (list (cons (quote syntax) (cons var1208 0))) r1200) (make-binding-wrap131 (list pat1204) labels1207 (quote (()))) mod1201)) (list x1197))) (gen-clause1195 x1197 keys1198 (cdr clauses1199) r1200 pat1204 #t exp1205 mod1201))) tmp1203) ((lambda (tmp1209) (if tmp1209 (apply (lambda (pat1210 fender1211 exp1212) (gen-clause1195 x1197 keys1198 (cdr clauses1199) r1200 pat1210 fender1211 exp1212 mod1201)) tmp1209) ((lambda (_1213) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1199))) tmp1202))) ($sc-dispatch tmp1202 (quote (any any any)))))) ($sc-dispatch tmp1202 (quote (any any))))) (car clauses1199))))) (gen-clause1195 (lambda (x1214 keys1215 clauses1216 r1217 pat1218 fender1219 exp1220 mod1221) (call-with-values (lambda () (convert-pattern1193 pat1218 keys1215)) (lambda (p1222 pvars1223) (if (not (distinct-bound-ids?140 (map car pvars1223))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1218) (if (not (and-map (lambda (x1224) (not (ellipsis?159 (car x1224)))) pvars1223)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1218) (let ((y1225 (gen-var161 (quote tmp)))) (build-application81 #f (build-lambda90 #f (list (quote tmp)) (list y1225) #f (let ((y1226 (build-lexical-reference83 (quote value) #f (quote tmp) y1225))) (build-conditional82 #f ((lambda (tmp1227) ((lambda (tmp1228) (if tmp1228 (apply (lambda () y1226) tmp1228) ((lambda (_1229) (build-conditional82 #f y1226 (build-dispatch-call1194 pvars1223 fender1219 y1226 r1217 mod1221) (build-data92 #f #f))) tmp1227))) ($sc-dispatch tmp1227 (quote #(atom #t))))) fender1219) (build-dispatch-call1194 pvars1223 exp1220 y1226 r1217 mod1221) (gen-syntax-case1196 x1214 keys1215 clauses1216 r1217 mod1221)))) (list (if (eq? p1222 (quote any)) (build-application81 #f (build-primref91 #f (quote list)) (list x1214)) (build-application81 #f (build-primref91 #f (quote $sc-dispatch)) (list x1214 (build-data92 #f p1222))))))))))))) (build-dispatch-call1194 (lambda (pvars1230 exp1231 y1232 r1233 mod1234) (let ((ids1235 (map car pvars1230)) (levels1236 (map cdr pvars1230))) (let ((labels1237 (gen-labels120 ids1235)) (new-vars1238 (map gen-var161 ids1235))) (build-application81 #f (build-primref91 #f (quote apply)) (list (build-lambda90 #f (map syntax->datum ids1235) new-vars1238 #f (chi150 exp1231 (extend-env108 labels1237 (map (lambda (var1239 level1240) (cons (quote syntax) (cons var1239 level1240))) new-vars1238 (map cdr pvars1230)) r1233) (make-binding-wrap131 ids1235 labels1237 (quote (()))) mod1234)) y1232)))))) (convert-pattern1193 (lambda (pattern1241 keys1242) (letrec ((cvt1243 (lambda (p1244 n1245 ids1246) (if (id?114 p1244) (if (bound-id-member?141 p1244 keys1242) (values (vector (quote free-id) p1244) ids1246) (values (quote any) (cons (cons p1244 n1245) ids1246))) ((lambda (tmp1247) ((lambda (tmp1248) (if (if tmp1248 (apply (lambda (x1249 dots1250) (ellipsis?159 dots1250)) tmp1248) #f) (apply (lambda (x1251 dots1252) (call-with-values (lambda () (cvt1243 x1251 (fx+72 n1245 1) ids1246)) (lambda (p1253 ids1254) (values (if (eq? p1253 (quote any)) (quote each-any) (vector (quote each) p1253)) ids1254)))) tmp1248) ((lambda (tmp1255) (if tmp1255 (apply (lambda (x1256 y1257) (call-with-values (lambda () (cvt1243 y1257 n1245 ids1246)) (lambda (y1258 ids1259) (call-with-values (lambda () (cvt1243 x1256 n1245 ids1259)) (lambda (x1260 ids1261) (values (cons x1260 y1258) ids1261)))))) tmp1255) ((lambda (tmp1262) (if tmp1262 (apply (lambda () (values (quote ()) ids1246)) tmp1262) ((lambda (tmp1263) (if tmp1263 (apply (lambda (x1264) (call-with-values (lambda () (cvt1243 x1264 n1245 ids1246)) (lambda (p1266 ids1267) (values (vector (quote vector) p1266) ids1267)))) tmp1263) ((lambda (x1268) (values (vector (quote atom) (strip160 p1244 (quote (())))) ids1246)) tmp1247))) ($sc-dispatch tmp1247 (quote #(vector each-any)))))) ($sc-dispatch tmp1247 (quote ()))))) ($sc-dispatch tmp1247 (quote (any . any)))))) ($sc-dispatch tmp1247 (quote (any any))))) p1244))))) (cvt1243 pattern1241 0 (quote ())))))) (lambda (e1269 r1270 w1271 s1272 mod1273) (let ((e1274 (source-wrap143 e1269 w1271 s1272 mod1273))) ((lambda (tmp1275) ((lambda (tmp1276) (if tmp1276 (apply (lambda (_1277 val1278 key1279 m1280) (if (and-map (lambda (x1281) (if (id?114 x1281) (not (ellipsis?159 x1281)) #f)) key1279) (let ((x1283 (gen-var161 (quote tmp)))) (build-application81 s1272 (build-lambda90 #f (list (quote tmp)) (list x1283) #f (gen-syntax-case1196 (build-lexical-reference83 (quote value) #f (quote tmp) x1283) key1279 m1280 r1270 mod1273)) (list (chi150 val1278 r1270 (quote (())) mod1273)))) (syntax-violation (quote syntax-case) "invalid literals list" e1274))) tmp1276) (syntax-violation #f "source expression failed to match any pattern" tmp1275))) ($sc-dispatch tmp1275 (quote (any any each-any . each-any))))) e1274))))) (set! sc-expand (lambda (x1287 . rest1286) (if (if (pair? x1287) (equal? (car x1287) noexpand70) #f) (cadr x1287) (let ((m1288 (if (null? rest1286) (quote e) (car rest1286))) (esew1289 (if (let ((t1290 (null? rest1286))) (if t1290 t1290 (null? (cdr rest1286)))) (quote (eval)) (cadr rest1286)))) (with-fluid* *mode*71 m1288 (lambda () (chi-top149 x1287 (quote ()) (quote ((top))) m1288 esew1289 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1291) (nonsymbol-id?113 x1291))) (set! datum->syntax (lambda (id1292 datum1293) (make-syntax-object97 datum1293 (syntax-object-wrap100 id1292) #f))) (set! syntax->datum (lambda (x1294) (strip160 x1294 (quote (()))))) (set! generate-temporaries (lambda (ls1295) (begin (let ((x1296 ls1295)) (if (not (list? x1296)) (syntax-violation (quote generate-temporaries) "invalid argument" x1296))) (map (lambda (x1297) (wrap142 (gensym) (quote ((top))) #f)) ls1295)))) (set! free-identifier=? (lambda (x1298 y1299) (begin (let ((x1300 x1298)) (if (not (nonsymbol-id?113 x1300)) (syntax-violation (quote free-identifier=?) "invalid argument" x1300))) (let ((x1301 y1299)) (if (not (nonsymbol-id?113 x1301)) (syntax-violation (quote free-identifier=?) "invalid argument" x1301))) (free-id=?137 x1298 y1299)))) (set! bound-identifier=? (lambda (x1302 y1303) (begin (let ((x1304 x1302)) (if (not (nonsymbol-id?113 x1304)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1304))) (let ((x1305 y1303)) (if (not (nonsymbol-id?113 x1305)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1305))) (bound-id=?138 x1302 y1303)))) (set! syntax-violation (lambda (who1309 message1308 form1307 . subform1306) (begin (let ((x1310 who1309)) (if (not ((lambda (x1311) (let ((t1312 (not x1311))) (if t1312 t1312 (let ((t1313 (string? x1311))) (if t1313 t1313 (symbol? x1311)))))) x1310)) (syntax-violation (quote syntax-violation) "invalid argument" x1310))) (let ((x1314 message1308)) (if (not (string? x1314)) (syntax-violation (quote syntax-violation) "invalid argument" x1314))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1309 "~a: " "") "~a " (if (null? subform1306) "in ~a" "in subform `~s' of `~s'")) (let ((tail1315 (cons message1308 (map (lambda (x1316) (strip160 x1316 (quote (())))) (append subform1306 (list form1307)))))) (if who1309 (cons who1309 tail1315) tail1315)) #f)))) (letrec ((match1321 (lambda (e1322 p1323 w1324 r1325 mod1326) (if (not r1325) #f (if (eq? p1323 (quote any)) (cons (wrap142 e1322 w1324 mod1326) r1325) (if (syntax-object?98 e1322) (match*1320 (syntax-object-expression99 e1322) p1323 (join-wraps133 w1324 (syntax-object-wrap100 e1322)) r1325 (syntax-object-module101 e1322)) (match*1320 e1322 p1323 w1324 r1325 mod1326)))))) (match*1320 (lambda (e1327 p1328 w1329 r1330 mod1331) (if (null? p1328) (if (null? e1327) r1330 #f) (if (pair? p1328) (if (pair? e1327) (match1321 (car e1327) (car p1328) w1329 (match1321 (cdr e1327) (cdr p1328) w1329 r1330 mod1331) mod1331) #f) (if (eq? p1328 (quote each-any)) (let ((l1332 (match-each-any1318 e1327 w1329 mod1331))) (if l1332 (cons l1332 r1330) #f)) (let ((atom-key1333 (vector-ref p1328 0))) (if (memv atom-key1333 (quote (each))) (if (null? e1327) (match-empty1319 (vector-ref p1328 1) r1330) (let ((l1334 (match-each1317 e1327 (vector-ref p1328 1) w1329 mod1331))) (if l1334 (letrec ((collect1335 (lambda (l1336) (if (null? (car l1336)) r1330 (cons (map car l1336) (collect1335 (map cdr l1336))))))) (collect1335 l1334)) #f))) (if (memv atom-key1333 (quote (free-id))) (if (id?114 e1327) (if (free-id=?137 (wrap142 e1327 w1329 mod1331) (vector-ref p1328 1)) r1330 #f) #f) (if (memv atom-key1333 (quote (atom))) (if (equal? (vector-ref p1328 1) (strip160 e1327 w1329)) r1330 #f) (if (memv atom-key1333 (quote (vector))) (if (vector? e1327) (match1321 (vector->list e1327) (vector-ref p1328 1) w1329 r1330 mod1331) #f))))))))))) (match-empty1319 (lambda (p1337 r1338) (if (null? p1337) r1338 (if (eq? p1337 (quote any)) (cons (quote ()) r1338) (if (pair? p1337) (match-empty1319 (car p1337) (match-empty1319 (cdr p1337) r1338)) (if (eq? p1337 (quote each-any)) (cons (quote ()) r1338) (let ((atom-key1339 (vector-ref p1337 0))) (if (memv atom-key1339 (quote (each))) (match-empty1319 (vector-ref p1337 1) r1338) (if (memv atom-key1339 (quote (free-id atom))) r1338 (if (memv atom-key1339 (quote (vector))) (match-empty1319 (vector-ref p1337 1) r1338))))))))))) (match-each-any1318 (lambda (e1340 w1341 mod1342) (if (pair? e1340) (let ((l1343 (match-each-any1318 (cdr e1340) w1341 mod1342))) (if l1343 (cons (wrap142 (car e1340) w1341 mod1342) l1343) #f)) (if (null? e1340) (quote ()) (if (syntax-object?98 e1340) (match-each-any1318 (syntax-object-expression99 e1340) (join-wraps133 w1341 (syntax-object-wrap100 e1340)) mod1342) #f))))) (match-each1317 (lambda (e1344 p1345 w1346 mod1347) (if (pair? e1344) (let ((first1348 (match1321 (car e1344) p1345 w1346 (quote ()) mod1347))) (if first1348 (let ((rest1349 (match-each1317 (cdr e1344) p1345 w1346 mod1347))) (if rest1349 (cons first1348 rest1349) #f)) #f)) (if (null? e1344) (quote ()) (if (syntax-object?98 e1344) (match-each1317 (syntax-object-expression99 e1344) p1345 (join-wraps133 w1346 (syntax-object-wrap100 e1344)) (syntax-object-module101 e1344)) #f)))))) (set! $sc-dispatch (lambda (e1350 p1351) (if (eq? p1351 (quote any)) (list e1350) (if (syntax-object?98 e1350) (match*1320 (syntax-object-expression99 e1350) p1351 (syntax-object-wrap100 e1350) (quote ()) (syntax-object-module101 e1350)) (match*1320 e1350 p1351 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x1352) ((lambda (tmp1353) ((lambda (tmp1354) (if tmp1354 (apply (lambda (_1355 e11356 e21357) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11356 e21357))) tmp1354) ((lambda (tmp1359) (if tmp1359 (apply (lambda (_1360 out1361 in1362 e11363 e21364) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in1362 (quote ()) (list out1361 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11363 e21364))))) tmp1359) ((lambda (tmp1366) (if tmp1366 (apply (lambda (_1367 out1368 in1369 e11370 e21371) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in1369) (quote ()) (list out1368 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11370 e21371))))) tmp1366) (syntax-violation #f "source expression failed to match any pattern" tmp1353))) ($sc-dispatch tmp1353 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1353 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1353 (quote (any () any . each-any))))) x1352))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1375) ((lambda (tmp1376) ((lambda (tmp1377) (if tmp1377 (apply (lambda (_1378 k1379 keyword1380 pattern1381 template1382) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k1379 (map (lambda (tmp1385 tmp1384) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp1384) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp1385))) template1382 pattern1381)))))) tmp1377) (syntax-violation #f "source expression failed to match any pattern" tmp1376))) ($sc-dispatch tmp1376 (quote (any each-any . #(each ((any . any) any))))))) x1375))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1386) ((lambda (tmp1387) ((lambda (tmp1388) (if (if tmp1388 (apply (lambda (let*1389 x1390 v1391 e11392 e21393) (and-map identifier? x1390)) tmp1388) #f) (apply (lambda (let*1395 x1396 v1397 e11398 e21399) (letrec ((f1400 (lambda (bindings1401) (if (null? bindings1401) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e11398 e21399))) ((lambda (tmp1405) ((lambda (tmp1406) (if tmp1406 (apply (lambda (body1407 binding1408) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding1408) body1407)) tmp1406) (syntax-violation #f "source expression failed to match any pattern" tmp1405))) ($sc-dispatch tmp1405 (quote (any any))))) (list (f1400 (cdr bindings1401)) (car bindings1401))))))) (f1400 (map list x1396 v1397)))) tmp1388) (syntax-violation #f "source expression failed to match any pattern" tmp1387))) ($sc-dispatch tmp1387 (quote (any #(each (any any)) any . each-any))))) x1386))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1409) ((lambda (tmp1410) ((lambda (tmp1411) (if tmp1411 (apply (lambda (_1412 var1413 init1414 step1415 e01416 e11417 c1418) ((lambda (tmp1419) ((lambda (tmp1420) (if tmp1420 (apply (lambda (step1421) ((lambda (tmp1422) ((lambda (tmp1423) (if tmp1423 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1413 init1414) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01416) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1418 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1421))))))) tmp1423) ((lambda (tmp1428) (if tmp1428 (apply (lambda (e11429 e21430) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1413 init1414) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01416 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e11429 e21430)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1418 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1421))))))) tmp1428) (syntax-violation #f "source expression failed to match any pattern" tmp1422))) ($sc-dispatch tmp1422 (quote (any . each-any)))))) ($sc-dispatch tmp1422 (quote ())))) e11417)) tmp1420) (syntax-violation #f "source expression failed to match any pattern" tmp1419))) ($sc-dispatch tmp1419 (quote each-any)))) (map (lambda (v1437 s1438) ((lambda (tmp1439) ((lambda (tmp1440) (if tmp1440 (apply (lambda () v1437) tmp1440) ((lambda (tmp1441) (if tmp1441 (apply (lambda (e1442) e1442) tmp1441) ((lambda (_1443) (syntax-violation (quote do) "bad step expression" orig-x1409 s1438)) tmp1439))) ($sc-dispatch tmp1439 (quote (any)))))) ($sc-dispatch tmp1439 (quote ())))) s1438)) var1413 step1415))) tmp1411) (syntax-violation #f "source expression failed to match any pattern" tmp1410))) ($sc-dispatch tmp1410 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1409))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1446 (lambda (x1450 y1451) ((lambda (tmp1452) ((lambda (tmp1453) (if tmp1453 (apply (lambda (x1454 y1455) ((lambda (tmp1456) ((lambda (tmp1457) (if tmp1457 (apply (lambda (dy1458) ((lambda (tmp1459) ((lambda (tmp1460) (if tmp1460 (apply (lambda (dx1461) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx1461 dy1458))) tmp1460) ((lambda (_1462) (if (null? dy1458) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1454) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1454 y1455))) tmp1459))) ($sc-dispatch tmp1459 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x1454)) tmp1457) ((lambda (tmp1463) (if tmp1463 (apply (lambda (stuff1464) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x1454 stuff1464))) tmp1463) ((lambda (else1465) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1454 y1455)) tmp1456))) ($sc-dispatch tmp1456 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1456 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y1455)) tmp1453) (syntax-violation #f "source expression failed to match any pattern" tmp1452))) ($sc-dispatch tmp1452 (quote (any any))))) (list x1450 y1451)))) (quasiappend1447 (lambda (x1466 y1467) ((lambda (tmp1468) ((lambda (tmp1469) (if tmp1469 (apply (lambda (x1470 y1471) ((lambda (tmp1472) ((lambda (tmp1473) (if tmp1473 (apply (lambda () x1470) tmp1473) ((lambda (_1474) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1470 y1471)) tmp1472))) ($sc-dispatch tmp1472 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y1471)) tmp1469) (syntax-violation #f "source expression failed to match any pattern" tmp1468))) ($sc-dispatch tmp1468 (quote (any any))))) (list x1466 y1467)))) (quasivector1448 (lambda (x1475) ((lambda (tmp1476) ((lambda (x1477) ((lambda (tmp1478) ((lambda (tmp1479) (if tmp1479 (apply (lambda (x1480) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x1480))) tmp1479) ((lambda (tmp1482) (if tmp1482 (apply (lambda (x1483) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1483)) tmp1482) ((lambda (_1485) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1477)) tmp1478))) ($sc-dispatch tmp1478 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp1478 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x1477)) tmp1476)) x1475))) (quasi1449 (lambda (p1486 lev1487) ((lambda (tmp1488) ((lambda (tmp1489) (if tmp1489 (apply (lambda (p1490) (if (= lev1487 0) p1490 (quasicons1446 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1449 (list p1490) (- lev1487 1))))) tmp1489) ((lambda (tmp1491) (if (if tmp1491 (apply (lambda (args1492) (= lev1487 0)) tmp1491) #f) (apply (lambda (args1493) (syntax-violation (quote unquote) "unquote takes exactly one argument" p1486 (cons (quote #(syntax-object unquote ((top) #(ribcage #(args) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1493))) tmp1491) ((lambda (tmp1494) (if tmp1494 (apply (lambda (p1495 q1496) (if (= lev1487 0) (quasiappend1447 p1495 (quasi1449 q1496 lev1487)) (quasicons1446 (quasicons1446 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1449 (list p1495) (- lev1487 1))) (quasi1449 q1496 lev1487)))) tmp1494) ((lambda (tmp1497) (if (if tmp1497 (apply (lambda (args1498 q1499) (= lev1487 0)) tmp1497) #f) (apply (lambda (args1500 q1501) (syntax-violation (quote unquote-splicing) "unquote-splicing takes exactly one argument" p1486 (cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1500))) tmp1497) ((lambda (tmp1502) (if tmp1502 (apply (lambda (p1503) (quasicons1446 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1449 (list p1503) (+ lev1487 1)))) tmp1502) ((lambda (tmp1504) (if tmp1504 (apply (lambda (p1505 q1506) (quasicons1446 (quasi1449 p1505 lev1487) (quasi1449 q1506 lev1487))) tmp1504) ((lambda (tmp1507) (if tmp1507 (apply (lambda (x1508) (quasivector1448 (quasi1449 x1508 lev1487))) tmp1507) ((lambda (p1510) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p1510)) tmp1488))) ($sc-dispatch tmp1488 (quote #(vector each-any)))))) ($sc-dispatch tmp1488 (quote (any . any)))))) ($sc-dispatch tmp1488 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp1488 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any) . any)))))) ($sc-dispatch tmp1488 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp1488 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1488 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p1486)))) (lambda (x1511) ((lambda (tmp1512) ((lambda (tmp1513) (if tmp1513 (apply (lambda (_1514 e1515) (quasi1449 e1515 0)) tmp1513) (syntax-violation #f "source expression failed to match any pattern" tmp1512))) ($sc-dispatch tmp1512 (quote (any any))))) x1511)))))
+(define include (make-syncase-macro (quote macro) (lambda (x1516) (letrec ((read-file1517 (lambda (fn1518 k1519) (let ((p1520 (open-input-file fn1518))) (letrec ((f1521 (lambda (x1522) (if (eof-object? x1522) (begin (close-input-port p1520) (quote ())) (cons (datum->syntax k1519 x1522) (f1521 (read p1520))))))) (f1521 (read p1520))))))) ((lambda (tmp1523) ((lambda (tmp1524) (if tmp1524 (apply (lambda (k1525 filename1526) (let ((fn1527 (syntax->datum filename1526))) ((lambda (tmp1528) ((lambda (tmp1529) (if tmp1529 (apply (lambda (exp1530) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp1530)) tmp1529) (syntax-violation #f "source expression failed to match any pattern" tmp1528))) ($sc-dispatch tmp1528 (quote each-any)))) (read-file1517 fn1527 k1525)))) tmp1524) (syntax-violation #f "source expression failed to match any pattern" tmp1523))) ($sc-dispatch tmp1523 (quote (any any))))) x1516)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x1532) ((lambda (tmp1533) ((lambda (tmp1534) (if tmp1534 (apply (lambda (_1535 e1536) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1532)) tmp1534) (syntax-violation #f "source expression failed to match any pattern" tmp1533))) ($sc-dispatch tmp1533 (quote (any any))))) x1532))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1537) ((lambda (tmp1538) ((lambda (tmp1539) (if tmp1539 (apply (lambda (_1540 e1541) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1537)) tmp1539) (syntax-violation #f "source expression failed to match any pattern" tmp1538))) ($sc-dispatch tmp1538 (quote (any any))))) x1537))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x1542) ((lambda (tmp1543) ((lambda (tmp1544) (if tmp1544 (apply (lambda (_1545 e1546 m11547 m21548) ((lambda (tmp1549) ((lambda (body1550) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1546)) body1550)) tmp1549)) (letrec ((f1551 (lambda (clause1552 clauses1553) (if (null? clauses1553) ((lambda (tmp1555) ((lambda (tmp1556) (if tmp1556 (apply (lambda (e11557 e21558) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11557 e21558))) tmp1556) ((lambda (tmp1560) (if tmp1560 (apply (lambda (k1561 e11562 e21563) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1561)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11562 e21563)))) tmp1560) ((lambda (_1566) (syntax-violation (quote case) "bad clause" x1542 clause1552)) tmp1555))) ($sc-dispatch tmp1555 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1555 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause1552) ((lambda (tmp1567) ((lambda (rest1568) ((lambda (tmp1569) ((lambda (tmp1570) (if tmp1570 (apply (lambda (k1571 e11572 e21573) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1571)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11572 e21573)) rest1568)) tmp1570) ((lambda (_1576) (syntax-violation (quote case) "bad clause" x1542 clause1552)) tmp1569))) ($sc-dispatch tmp1569 (quote (each-any any . each-any))))) clause1552)) tmp1567)) (f1551 (car clauses1553) (cdr clauses1553))))))) (f1551 m11547 m21548)))) tmp1544) (syntax-violation #f "source expression failed to match any pattern" tmp1543))) ($sc-dispatch tmp1543 (quote (any any any . each-any))))) x1542))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1577) ((lambda (tmp1578) ((lambda (tmp1579) (if tmp1579 (apply (lambda (_1580 e1581) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1581)) (list (cons _1580 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e1581 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp1579) (syntax-violation #f "source expression failed to match any pattern" tmp1578))) ($sc-dispatch tmp1578 (quote (any any))))) x1577))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index c2668c0c4..f18b626e3 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -560,7 +560,6 @@
 
 ;;; <binding> ::= (macro . <procedure>)           macros
 ;;;               (core . <procedure>)            core forms
-;;;               (external-macro . <procedure>)  external-macro
 ;;;               (module-ref . <procedure>)      @ or @@
 ;;;               (begin)                         begin
 ;;;               (define)                        define
@@ -999,9 +998,9 @@
 ;;;
 ;;;    type                   value         explanation
 ;;;    -------------------------------------------------------------------
-;;;    core                   procedure     core form (including singleton)
-;;;    external-macro         procedure     external macro
-;;;    module-ref             procedure     @ or @@ form
+;;;    core                   procedure     core singleton
+;;;    core-form              procedure     core form
+;;;    module-ref             procedure     @ or @@ singleton
 ;;;    lexical                name          lexical variable reference
 ;;;    global                 name          global variable reference
 ;;;    begin                  none          begin keyword
@@ -1031,7 +1030,7 @@
 ;;; forms, although perhaps this should be done by the consumer.
 
 (define syntax-type
-  (lambda (e r w s rib mod)
+  (lambda (e r w s rib mod for-car?)
     (cond
       ((symbol? e)
        (let* ((n (id-var-name e w))
@@ -1041,64 +1040,70 @@
            ((lexical) (values type (binding-value b) e w s mod))
            ((global) (values type n e w s mod))
            ((macro)
-            (syntax-type (chi-macro (binding-value b) e r w rib mod)
-                         r empty-wrap s rib mod))
+            (if for-car?
+                (values type (binding-value b) e w s mod)
+                (syntax-type (chi-macro (binding-value b) e r w rib mod)
+                             r empty-wrap s rib mod #f)))
            (else (values type (binding-value b) e w s mod)))))
       ((pair? e)
        (let ((first (car e)))
-         (if (id? first)
-             (let* ((n (id-var-name first w))
-                    (b (lookup n r (or (and (syntax-object? first)
-                                            (syntax-object-module first))
-                                       mod)))
-                    (type (binding-type b)))
-               (case type
-                 ((lexical)
-                  (values 'lexical-call (binding-value b) e w s mod))
-                 ((global)
-                  (values 'global-call n e w s mod))
-                 ((macro)
-                  (syntax-type (chi-macro (binding-value b) e r w rib mod)
-                    r empty-wrap s rib mod))
-                 ((core external-macro module-ref)
-                  (values type (binding-value b) e w s mod))
-                 ((local-syntax)
-                  (values 'local-syntax-form (binding-value b) e w s mod))
-                 ((begin)
-                  (values 'begin-form #f e w s mod))
-                 ((eval-when)
-                  (values 'eval-when-form #f e w s mod))
-                 ((define)
-                  (syntax-case e ()
-                    ((_ name val)
-                     (id? (syntax name))
-                     (values 'define-form (syntax name) (syntax val) w s mod))
-                    ((_ (name . args) e1 e2 ...)
-                     (and (id? (syntax name))
-                          (valid-bound-ids? (lambda-var-list (syntax args))))
-                     ; need lambda here...
-                     (values 'define-form (wrap (syntax name) w mod)
-                       (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w mod))
-                       empty-wrap s mod))
-                    ((_ name)
-                     (id? (syntax name))
-                     (values 'define-form (wrap (syntax name) w mod)
-                       (syntax (if #f #f))
-                       empty-wrap s mod))))
-                 ((define-syntax)
-                  (syntax-case e ()
-                    ((_ name val)
-                     (id? (syntax name))
-                     (values 'define-syntax-form (syntax name)
-                       (syntax val) w s mod))))
-                 (else
-                  (values 'call #f e w s mod))))
-             (values 'call #f e w s mod))))
+         (call-with-values
+             (lambda () (syntax-type first r w s rib mod #t))
+           (lambda (ftype fval fe fw fs fmod)
+             (case ftype
+               ((lexical)
+                (values 'lexical-call fval e w s mod))
+               ((global)
+                ;; If we got here via an (@@ ...) expansion, we need to
+                ;; make sure the fmod information is propagated back
+                ;; correctly -- hence this consing.
+                (values 'global-call (make-syntax-object fval w fmod)
+                        e w s mod))
+               ((macro)
+                (syntax-type (chi-macro fval e r w rib mod)
+                             r empty-wrap s rib mod for-car?))
+               ((module-ref)
+                (call-with-values (lambda () (fval e))
+                  (lambda (sym mod)
+                    (syntax-type sym r w s rib mod for-car?))))
+               ((core)
+                (values 'core-form fval e w s mod))
+               ((local-syntax)
+                (values 'local-syntax-form fval e w s mod))
+               ((begin)
+                (values 'begin-form #f e w s mod))
+               ((eval-when)
+                (values 'eval-when-form #f e w s mod))
+               ((define)
+                (syntax-case e ()
+                  ((_ name val)
+                   (id? (syntax name))
+                   (values 'define-form (syntax name) (syntax val) w s mod))
+                  ((_ (name . args) e1 e2 ...)
+                   (and (id? (syntax name))
+                        (valid-bound-ids? (lambda-var-list (syntax args))))
+                                        ; need lambda here...
+                   (values 'define-form (wrap (syntax name) w mod)
+                           (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w mod))
+                           empty-wrap s mod))
+                  ((_ name)
+                   (id? (syntax name))
+                   (values 'define-form (wrap (syntax name) w mod)
+                           (syntax (if #f #f))
+                           empty-wrap s mod))))
+               ((define-syntax)
+                (syntax-case e ()
+                  ((_ name val)
+                   (id? (syntax name))
+                   (values 'define-syntax-form (syntax name)
+                           (syntax val) w s mod))))
+               (else
+                (values 'call #f e w s mod)))))))
       ((syntax-object? e)
        (syntax-type (syntax-object-expression e)
                     r
                     (join-wraps w (syntax-object-wrap e))
-                    s rib (or (syntax-object-module e) mod)))
+                    s rib (or (syntax-object-module e) mod) for-car?))
       ((self-evaluating? e) (values 'constant #f e w s mod))
       (else (values 'other #f e w s mod)))))
 
@@ -1111,7 +1116,7 @@
            (if (eq? m 'c&e) (top-level-eval-hook x mod))
            x))))
     (call-with-values
-      (lambda () (syntax-type e r w (source-annotation e) #f mod))
+      (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
       (lambda (type value e w s mod)
         (case type
           ((begin-form)
@@ -1187,7 +1192,7 @@
 (define chi
   (lambda (e r w mod)
     (call-with-values
-      (lambda () (syntax-type e r w (source-annotation e) #f mod))
+      (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
       (lambda (type value e w s mod)
         (chi-expr type value e r w s mod)))))
 
@@ -1196,7 +1201,7 @@
     (case type
       ((lexical)
        (build-lexical-reference 'value s e value))
-      ((core external-macro)
+      ((core core-form)
        ;; apply transformer
        (value e r w s mod))
       ((module-ref)
@@ -1210,9 +1215,12 @@
          e r w s mod))
       ((global-call)
        (chi-application
-         (build-global-reference (source-annotation (car e)) value
-                                 (if (syntax-object? (car e))
-                                     (syntax-object-module (car e))
+         (build-global-reference (source-annotation (car e))
+                                 (if (syntax-object? value)
+                                     (syntax-object-expression value)
+                                     value)
+                                 (if (syntax-object? value)
+                                     (syntax-object-module value)
                                      mod))
          e r w s mod))
       ((constant) (build-data s (strip (source-wrap e w s mod) empty-wrap)))
@@ -1342,7 +1350,7 @@
             (syntax-violation #f "no expressions in body" outer-form)
             (let ((e (cdar body)) (er (caar body)))
               (call-with-values
-                (lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod))
+                (lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod #f))
                 (lambda (type value e w s mod)
                   (case type
                     ((define-form)
@@ -1843,7 +1851,7 @@
                                      (source-wrap e w s mod)))))))
       ((_ (head tail ...) val)
        (call-with-values
-           (lambda () (syntax-type (syntax head) r empty-wrap no-source #f mod))
+           (lambda () (syntax-type (syntax head) r empty-wrap no-source #f mod #t))
          (lambda (type value ee ww ss modmod)
            (case type
              ((module-ref)
diff --git a/module/language/assembly.scm b/module/language/assembly.scm
index 28dde1e1a..3ffbf11f1 100644
--- a/module/language/assembly.scm
+++ b/module/language/assembly.scm
@@ -20,11 +20,12 @@
 ;;; Code:
 
 (define-module (language assembly)
+  #:use-module (rnrs bytevector)
   #:use-module (system base pmatch)
   #:use-module (system vm instruction)
   #:use-module ((srfi srfi-1) #:select (fold))
   #:export (byte-length
-            addr+ align-program
+            addr+ align-program align-code
             assembly-pack assembly-unpack
             object->assembly assembly->object))
 
@@ -50,6 +51,8 @@
      (+ 1 *len-len* (string-length str)))
     ((load-keyword ,str)
      (+ 1 *len-len* (string-length str)))
+    ((load-array ,bv)
+     (+ 1 *len-len* (bytevector-length bv)))
     ((define ,str)
      (+ 1 *len-len* (string-length str)))
     ((load-program ,nargs ,nrest ,nlocs ,nexts ,labels ,len ,meta . ,code)
@@ -66,13 +69,16 @@
         addr
         code))
 
-(define (align-program prog addr)
-  `(,@(make-list (modulo (- *program-alignment*
-                            (modulo (1+ addr) *program-alignment*))
-                         ;; plus the one for the load-program inst itself
-                         *program-alignment*)
+
+(define (align-code code addr alignment header-len)
+  `(,@(make-list (modulo (- alignment
+                            (modulo (+ addr header-len) alignment))
+                         alignment)
                  '(nop))
-    ,prog))
+    ,code))
+
+(define (align-program prog addr)
+  (align-code prog addr *program-alignment* 1))
 
 ;;;
 ;;; Code compress/decompression
diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
index 00a324c31..e4458a992 100644
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -24,6 +24,7 @@
   #:use-module (language assembly)
   #:use-module (system vm instruction)
   #:use-module (srfi srfi-4)
+  #:use-module (rnrs bytevector)
   #:use-module ((srfi srfi-1) #:select (fold))
   #:use-module ((system vm objcode) #:select (byte-order))
   #:export (compile-bytecode write-bytecode))
@@ -72,6 +73,10 @@
   (define (write-loader str)
     (write-loader-len (string-length str))
     (write-string str))
+  (define (write-bytevector bv)
+    (write-loader-len (bytevector-length bv))
+    ;; Ew!
+    (for-each write-byte (bytevector->u8-list bv)))
   (define (write-break label)
     (write-uint16-be (- (assq-ref labels label) (+ (get-addr) 2))))
   
@@ -113,6 +118,7 @@
         ((load-string ,str) (write-loader str))
         ((load-symbol ,str) (write-loader str))
         ((load-keyword ,str) (write-loader str))
+        ((load-array ,bv) (write-bytevector bv))
         ((define ,str) (write-loader str))
         ((br ,l) (write-break l))
         ((br-if ,l) (write-break l))
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index 4c92e0f5a..dcdbc5133 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -28,6 +28,7 @@
   #:use-module ((system vm program) #:select (make-binding))
   #:use-module (ice-9 receive)
   #:use-module ((srfi srfi-1) #:select (fold))
+  #:use-module (rnrs bytevector)
   #:export (compile-assembly))
 
 ;; Variable cache cells go in the object table, and serialize as their
@@ -186,7 +187,11 @@
                  (receive (i object-alist)
                      (object-index-and-alist (make-subprogram table prog)
                                              object-alist)
-                   (emit-code/object `((object-ref ,i) ,@closure)
+                   (emit-code/object `(,(if (< i 256)
+                                            `(object-ref ,i)
+                                            `(long-object-ref ,(quotient i 256)
+                                                              ,(modulo i 256)))
+                                       ,@closure)
                                      object-alist)))
                 (else
                  ;; otherwise emit a load directly
@@ -234,7 +239,10 @@
       (else
        (receive (i object-alist)
            (object-index-and-alist obj object-alist)
-         (emit-code/object `((object-ref ,i))
+         (emit-code/object (if (< i 256)
+                               `((object-ref ,i))
+                               `((long-object-ref ,(quotient i 256)
+                                                  ,(modulo i 256))))
                            object-alist)))))
 
     ((<glil-local> op index)
@@ -264,9 +272,16 @@
           (receive (i object-alist)
               (object-index-and-alist (make-variable-cache-cell name)
                                       object-alist)
-            (emit-code/object (case op
-                                ((ref) `((toplevel-ref ,i)))
-                                ((set) `((toplevel-set ,i))))
+            (emit-code/object (if (< i 256)
+                                  `((,(case op
+                                        ((ref) 'toplevel-ref)
+                                        ((set) 'toplevel-set))
+                                     ,i))
+                                  `((,(case op
+                                        ((ref) 'long-toplevel-ref)
+                                        ((set) 'long-toplevel-set))
+                                     ,(quotient i 256)
+                                     ,(modulo i 256))))
                               object-alist)))))
        ((define)
         (emit-code `((define ,(symbol->string name))
@@ -379,6 +394,16 @@
             (let ((code (dump-object (vector-ref x i) addr)))
               (dump-objects (1+ i) (cons code codes)
                             (addr+ addr code)))))))
+   ((and (array? x) (symbol? (array-type x)))
+    (let* ((type (dump-object (array-type x) addr))
+           (shape (dump-object (array-shape x) (addr+ addr type))))
+      `(,@type
+        ,@shape
+        ,@(align-code
+           `(load-array ,(uniform-array->bytevector x))
+           (addr+ (addr+ addr type) shape)
+           8
+           4))))
    (else
     (error "assemble: unrecognized object" x))))
 
diff --git a/module/rnrs/bytevector.scm b/module/rnrs/bytevector.scm
new file mode 100644
index 000000000..7728a1581
--- /dev/null
+++ b/module/rnrs/bytevector.scm
@@ -0,0 +1,85 @@
+;;;; bytevector.scm --- R6RS bytevector API
+
+;;;;	Copyright (C) 2009 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 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
+
+;;; Author: Ludovic Courtès <ludo@gnu.org>
+
+;;; Commentary:
+;;;
+;;; A "bytevector" is a raw bit string.  This module provides procedures to
+;;; manipulate bytevectors and interpret their contents in a number of ways:
+;;; bytevector contents can be accessed as signed or unsigned integer of
+;;; various sizes and endianness, as IEEE-754 floating point numbers, or as
+;;; strings.  It is a useful tool to decode binary data.
+;;;
+;;; Code:
+
+(define-module (rnrs bytevector)
+  :export-syntax (endianness)
+  :export (native-endianness bytevector?
+           make-bytevector bytevector-length bytevector=? bytevector-fill!
+           bytevector-copy! bytevector-copy
+           uniform-array->bytevector
+           bytevector-u8-ref bytevector-s8-ref
+           bytevector-u8-set! bytevector-s8-set! bytevector->u8-list
+           u8-list->bytevector
+           bytevector-uint-ref bytevector-uint-set!
+           bytevector-sint-ref bytevector-sint-set!
+           bytevector->sint-list bytevector->uint-list
+           uint-list->bytevector sint-list->bytevector
+
+           bytevector-u16-ref bytevector-s16-ref
+           bytevector-u16-set! bytevector-s16-set!
+           bytevector-u16-native-ref bytevector-s16-native-ref
+           bytevector-u16-native-set! bytevector-s16-native-set!
+
+           bytevector-u32-ref bytevector-s32-ref
+           bytevector-u32-set! bytevector-s32-set!
+           bytevector-u32-native-ref bytevector-s32-native-ref
+           bytevector-u32-native-set! bytevector-s32-native-set!
+
+           bytevector-u64-ref bytevector-s64-ref
+           bytevector-u64-set! bytevector-s64-set!
+           bytevector-u64-native-ref bytevector-s64-native-ref
+           bytevector-u64-native-set! bytevector-s64-native-set!
+
+           bytevector-ieee-single-ref
+           bytevector-ieee-single-set!
+           bytevector-ieee-single-native-ref
+           bytevector-ieee-single-native-set!
+
+           bytevector-ieee-double-ref
+           bytevector-ieee-double-set!
+           bytevector-ieee-double-native-ref
+           bytevector-ieee-double-native-set!
+
+           string->utf8 string->utf16 string->utf32
+           utf8->string utf16->string utf32->string))
+
+
+(load-extension "libguile" "scm_init_bytevectors")
+
+(define-macro (endianness sym)
+  (if (memq sym '(big little))
+      `(quote ,sym)
+      (error "unsupported endianness" sym)))
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; End:
+
+;;; bytevector.scm ends here
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
new file mode 100644
index 000000000..73843ee55
--- /dev/null
+++ b/module/rnrs/io/ports.scm
@@ -0,0 +1,111 @@
+;;;; ports.scm --- R6RS port API
+
+;;;;	Copyright (C) 2009 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 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
+
+;;; Author: Ludovic Courtès <ludo@gnu.org>
+
+;;; Commentary:
+;;;
+;;; The I/O port API of the R6RS is provided by this module.  In many areas
+;;; it complements or refines Guile's own historical port API.  For instance,
+;;; it allows for binary I/O with bytevectors.
+;;;
+;;; Code:
+
+(define-module (rnrs io ports)
+  :re-export (eof-object? port? input-port? output-port?)
+  :export (eof-object
+
+           ;; input & output ports
+           port-transcoder binary-port? transcoded-port
+           port-position set-port-position!
+           port-has-port-position? port-has-set-port-position!?
+           call-with-port
+
+           ;; input ports
+           open-bytevector-input-port
+           make-custom-binary-input-port
+
+           ;; binary input
+           get-u8 lookahead-u8
+           get-bytevector-n get-bytevector-n!
+           get-bytevector-some get-bytevector-all
+
+           ;; output ports
+           open-bytevector-output-port
+           make-custom-binary-output-port
+
+           ;; binary output
+           put-u8 put-bytevector))
+
+(load-extension "libguile" "scm_init_r6rs_ports")
+
+
+
+;;;
+;;; Input and output ports.
+;;;
+
+(define (port-transcoder port)
+  (error "port transcoders are not supported" port))
+
+(define (binary-port? port)
+  ;; So far, we don't support transcoders other than the binary transcoder.
+  #t)
+
+(define (transcoded-port port)
+  (error "port transcoders are not supported" port))
+
+(define (port-position port)
+  "Return the offset (an integer) indicating where the next octet will be
+read from/written to in @var{port}."
+
+  ;; FIXME: We should raise an `&assertion' error when not supported.
+  (seek port 0 SEEK_CUR))
+
+(define (set-port-position! port offset)
+  "Set the position where the next octet will be read from/written to
+@var{port}."
+
+  ;; FIXME: We should raise an `&assertion' error when not supported.
+  (seek port offset SEEK_SET))
+
+(define (port-has-port-position? port)
+  "Return @code{#t} is @var{port} supports @code{port-position}."
+  (and (false-if-exception (port-position port)) #t))
+
+(define (port-has-set-port-position!? port)
+  "Return @code{#t} is @var{port} supports @code{set-port-position!}."
+  (and (false-if-exception (set-port-position! port (port-position port)))
+       #t))
+
+(define (call-with-port port proc)
+  "Call @var{proc}, passing it @var{port} and closing @var{port} upon exit of
+@var{proc}.  Return the return values of @var{proc}."
+  (dynamic-wind
+      (lambda ()
+        #t)
+      (lambda ()
+        (proc port))
+      (lambda ()
+        (close-port port))))
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; End:
+
+;;; ports.scm ends here
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
index f0294b5d6..84d235b8a 100644
--- a/module/scripts/compile.scm
+++ b/module/scripts/compile.scm
@@ -111,10 +111,13 @@ Compile each Guile source file FILE into a Guile object.
   -f, --from=LANG      specify a source language other than `scheme'
   -t, --to=LANG        specify a target language other than `objcode'
 
+Note that autocompilation will be turned off.
+
 Report bugs to <guile-user@gnu.org>.~%")
           (exit 0)))
 
     (set! %load-path (append load-path %load-path))
+    (set! %load-should-autocompile #f)
 
     (if (and output-file
              (or (null? input-files)
diff --git a/module/srfi/srfi-98.scm b/module/srfi/srfi-98.scm
new file mode 100644
index 000000000..924a20578
--- /dev/null
+++ b/module/srfi/srfi-98.scm
@@ -0,0 +1,44 @@
+;;; srfi-98.scm --- An interface to access environment variables
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 2.1 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
+
+;;; Author: Julian Graham <julian.graham@aya.yale.edu>
+;;; Date: 2009-05-26
+
+;;; Commentary:
+
+;; This is an implementation of SRFI-98 (An interface to access environment 
+;; variables).
+;;
+;; This module is fully documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-98)
+  :use-module (srfi srfi-1)
+  :export (get-environment-variable
+	   get-environment-variables))
+
+(cond-expand-provide (current-module) '(srfi-98))
+
+(define get-environment-variable getenv)
+(define (get-environment-variables)
+  (define (string->alist-entry str)
+    (let ((pvt (string-index str #\=))
+	  (len (string-length str)))
+      (and pvt (cons (substring str 0 pvt) (substring str (+ pvt 1) len)))))
+  (filter-map string->alist-entry (environ)))
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 74fb59852..9f0ff2f3d 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -73,7 +73,7 @@
         thunk
         (lambda () #t))))
 
-(define (call-with-output-file/atomic filename proc)
+(define* (call-with-output-file/atomic filename proc #:optional reference)
   (let* ((template (string-append filename ".XXXXXX"))
          (tmp (mkstemp! template)))
     (call-once
@@ -83,6 +83,9 @@
            (proc tmp)
            (chmod tmp (logand #o0666 (lognot (umask))))
            (close-port tmp)
+           (if reference
+               (let ((st (stat reference)))
+                 (utime template (stat:atime st) (stat:mtime st))))
            (rename-file template filename))
          (lambda args
            (delete-file template)))))))
@@ -92,6 +95,46 @@
       x
       (lookup-language x)))
 
+;; Throws an exception if `dir' is not writable. The double-stat is OK,
+;; as this is only used during compilation.
+(define (ensure-writable-dir dir)
+  (if (file-exists? dir)
+      (if (access? dir W_OK)
+          #t
+          (error "directory not writable" dir))
+      (begin
+        (ensure-writable-dir (dirname dir))
+        (mkdir dir))))
+
+(define (dsu-sort list key less)
+  (map cdr
+       (stable-sort (map (lambda (x) (cons (key x) x)) list)
+                    (lambda (x y) (less (car x) (car y))))))
+
+;;; This function is among the trickiest I've ever written. I tried many
+;;; variants. In the end, simple is best, of course.
+;;;
+;;; After turning this around a number of times, it seems that the the
+;;; desired behavior is that .go files should exist in a path, for
+;;; searching. That is orthogonal to this function. For writing .go
+;;; files, either you know where they should go, in which case you tell
+;;; compile-file explicitly, as in the srcdir != builddir case; or you
+;;; don't know, in which case this function is called, and we just put
+;;; them in your own ccache dir in ~/.guile-ccache.
+(define (compiled-file-name file)
+  (define (compiled-extension)
+    (cond ((or (null? %load-compiled-extensions)
+               (string-null? (car %load-compiled-extensions)))
+           (warn "invalid %load-compiled-extensions"
+                 %load-compiled-extensions)
+           ".go")
+          (else (car %load-compiled-extensions))))
+  (and %compile-fallback-path
+       (let ((f (string-append
+                 %compile-fallback-path "/" file (compiled-extension))))
+         (and (false-if-exception (ensure-writable-dir (dirname f)))
+              f))))
+
 (define* (compile-file file #:key
                        (output-file #f)
                        (env #f)
@@ -100,35 +143,18 @@
                        (opts '()))
   (let ((comp (or output-file (compiled-file-name file)))
         (in (open-input-file file)))
+    (ensure-writable-dir (dirname comp))
     (call-with-output-file/atomic comp
       (lambda (port)
         ((language-printer (ensure-language to))
          (read-and-compile in #:env env #:from from #:to to #:opts opts)
-         port)))
+         port))
+      file)
     comp))
 
-(define* (compile-and-load file #:key (to 'value) (opts '()))
-  (read-and-compile (open-input-port file)
-                    #:from lang #:to to #:opts opts))
-
-(define (compiled-file-name file)
-  (let ((base (basename file))
-        (cext (cond ((or (null? %load-compiled-extensions)
-                         (string-null? (car %load-compiled-extensions)))
-                     (warn "invalid %load-compiled-extensions"
-                           %load-compiled-extensions)
-                     ".go")
-                    (else (car %load-compiled-extensions)))))
-    (let lp ((exts %load-extensions))
-      (cond ((null? exts) (string-append file cext))
-            ((string-null? (car exts)) (lp (cdr exts)))
-            ((string-suffix? (car exts) base)
-             (string-append
-              (dirname file) "/"
-              (substring base 0
-                         (- (string-length base) (string-length (car exts))))
-              cext))
-            (else (lp (cdr exts)))))))
+(define* (compile-and-load file #:key (from 'scheme) (to 'value) (opts '()))
+  (read-and-compile (open-input-file file)
+                    #:from from #:to to #:opts opts))
 
 
 ;;;
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 358421aa6..8ac209339 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -26,6 +26,7 @@ SCM_TESTS = tests/alist.test			\
 	    tests/arbiters.test			\
 	    tests/asm-to-bytecode.test		\
 	    tests/bit-operations.test		\
+	    tests/bytevectors.test		\
 	    tests/c-api.test			\
 	    tests/chars.test			\
 	    tests/common-list.test		\
@@ -62,6 +63,7 @@ SCM_TESTS = tests/alist.test			\
 	    tests/q.test			\
 	    tests/r4rs.test			\
 	    tests/r5rs_pitfall.test		\
+	    tests/r6rs-ports.test		\
 	    tests/ramap.test			\
 	    tests/reader.test			\
 	    tests/receive.test			\
diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test
new file mode 100644
index 000000000..b2ae65c1f
--- /dev/null
+++ b/test-suite/tests/bytevectors.test
@@ -0,0 +1,531 @@
+;;;; bytevectors.test --- Exercise the R6RS bytevector API.
+;;;;
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Ludovic Courtès
+;;;;
+;;;; 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 2.1 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
+
+(define-module (test-bytevector)
+  :use-module (test-suite lib)
+  :use-module (rnrs bytevector))
+
+;;; Some of the tests in here are examples taken from the R6RS Standard
+;;; Libraries document.
+
+
+(with-test-prefix "2.2 General Operations"
+
+  (pass-if "native-endianness"
+    (not (not (memq (native-endianness) '(big little)))))
+
+  (pass-if "make-bytevector"
+    (and (bytevector? (make-bytevector 20))
+         (bytevector? (make-bytevector 20 3))))
+
+  (pass-if "bytevector-length"
+    (= (bytevector-length (make-bytevector 20)) 20))
+
+  (pass-if "bytevector=?"
+    (and (bytevector=? (make-bytevector 20 7)
+                       (make-bytevector 20 7))
+         (not (bytevector=? (make-bytevector 20 7)
+                            (make-bytevector 20 0))))))
+
+
+(with-test-prefix "2.3 Operations on Bytes and Octets"
+
+  (pass-if "bytevector-{u8,s8}-ref"
+    (equal? '(-127 129 -1 255)
+            (let ((b1 (make-bytevector 16 -127))
+                  (b2 (make-bytevector 16 255)))
+              (list (bytevector-s8-ref b1 0)
+                    (bytevector-u8-ref b1 0)
+                    (bytevector-s8-ref b2 0)
+                    (bytevector-u8-ref b2 0)))))
+
+  (pass-if "bytevector-{u8,s8}-set!"
+    (equal? '(-126 130 -10 246)
+            (let ((b (make-bytevector 16 -127)))
+
+              (bytevector-s8-set! b 0 -126)
+              (bytevector-u8-set! b 1 246)
+
+              (list (bytevector-s8-ref b 0)
+                    (bytevector-u8-ref b 0)
+                    (bytevector-s8-ref b 1)
+                    (bytevector-u8-ref b 1)))))
+
+  (pass-if "bytevector->u8-list"
+    (let ((lst '(1 2 3 128 150 255)))
+      (equal? lst
+              (bytevector->u8-list
+               (let ((b (make-bytevector 6)))
+                 (for-each (lambda (i v)
+                             (bytevector-u8-set! b i v))
+                           (iota 6)
+                           lst)
+                 b)))))
+
+  (pass-if "u8-list->bytevector"
+    (let ((lst '(1 2 3 128 150 255)))
+      (equal? lst
+              (bytevector->u8-list (u8-list->bytevector lst)))))
+
+  (pass-if "bytevector-uint-{ref,set!} [small]"
+    (let ((b (make-bytevector 15)))
+      (bytevector-uint-set! b 0 #x1234
+                            (endianness little) 2)
+      (equal? (bytevector-uint-ref b 0 (endianness big) 2)
+              #x3412)))
+
+  (pass-if "bytevector-uint-set! [large]"
+    (let ((b (make-bytevector 16)))
+      (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                            (endianness little) 16)
+      (equal? (bytevector->u8-list b)
+              '(253 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 255))))
+
+  (pass-if "bytevector-uint-{ref,set!} [large]"
+    (let ((b (make-bytevector 120)))
+      (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                            (endianness little) 16)
+      (equal? (bytevector-uint-ref b 0 (endianness little) 16)
+              #xfffffffffffffffffffffffffffffffd)))
+
+  (pass-if "bytevector-sint-ref [small]"
+    (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
+      (equal? (bytevector-sint-ref b 0 (endianness big) 2)
+              (bytevector-sint-ref b 1 (endianness little) 2)
+              -16)))
+
+  (pass-if "bytevector-sint-ref [large]"
+    (let ((b (make-bytevector 50)))
+      (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                            (endianness little) 16)
+      (equal? (bytevector-sint-ref b 0 (endianness little) 16)
+              -3)))
+
+  (pass-if "bytevector-sint-set! [small]"
+    (let ((b (make-bytevector 3)))
+      (bytevector-sint-set! b 0 -16 (endianness big) 2)
+      (bytevector-sint-set! b 1 -16 (endianness little) 2)
+      (equal? (bytevector->u8-list b)
+	      '(#xff #xf0 #xff)))))
+
+
+(with-test-prefix "2.4 Operations on Integers of Arbitrary Size"
+
+  (pass-if "bytevector->sint-list"
+    (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+      (equal? (bytevector->sint-list b (endianness little) 2)
+              '(513 -253 513 513))))
+
+  (pass-if "bytevector->uint-list"
+    (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1))))
+      (equal? (bytevector->uint-list b (endianness big) 2)
+              '(513 65283 513 513))))
+
+  (pass-if "bytevector->uint-list [empty]"
+    (let ((b (make-bytevector 0)))
+      (null? (bytevector->uint-list b (endianness big) 2))))
+
+  (pass-if-exception "bytevector->sint-list [out-of-range]"
+    exception:out-of-range
+    (bytevector->sint-list (make-bytevector 6) (endianness little) 8))
+
+  (pass-if "bytevector->sint-list [off-by-one]"
+    (equal? (bytevector->sint-list (make-bytevector 31 #xff)
+                                   (endianness little) 8)
+            '(-1 -1 -1)))
+
+  (pass-if "{sint,uint}-list->bytevector"
+    (let ((b1 (sint-list->bytevector '(513 -253 513 513)
+                                     (endianness little) 2))
+          (b2 (uint-list->bytevector '(513 65283 513 513)
+                                     (endianness little) 2))
+          (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+      (and (bytevector=? b1 b2)
+           (bytevector=? b2 b3))))
+
+  (pass-if "sint-list->bytevector [limits]"
+           (bytevector=? (sint-list->bytevector '(-32768 32767)
+                                                (endianness big) 2)
+                         (let ((bv (make-bytevector 4)))
+                           (bytevector-u8-set! bv 0 #x80)
+                           (bytevector-u8-set! bv 1 #x00)
+                           (bytevector-u8-set! bv 2 #x7f)
+                           (bytevector-u8-set! bv 3 #xff)
+                           bv)))
+
+  (pass-if-exception "sint-list->bytevector [out-of-range]"
+    exception:out-of-range
+    (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big)
+                           2))
+
+  (pass-if-exception "uint-list->bytevector [out-of-range]"
+    exception:out-of-range
+    (uint-list->bytevector '(0 -1) (endianness big) 2)))
+
+
+(with-test-prefix "2.5 Operations on 16-Bit Integers"
+
+  (pass-if "bytevector-u16-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-u16-ref b 14 (endianness little))
+                   #xfdff)
+           (equal? (bytevector-u16-ref b 14 (endianness big))
+                   #xfffd))))
+
+  (pass-if "bytevector-s16-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-s16-ref b 14 (endianness little))
+                   -513)
+           (equal? (bytevector-s16-ref b 14 (endianness big))
+                   -3))))
+
+  (pass-if "bytevector-s16-ref [unaligned]"
+    (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
+      (equal? (bytevector-s16-ref b 1 (endianness little))
+	      -16)))
+
+  (pass-if "bytevector-{u16,s16}-ref"
+    (let ((b (make-bytevector 2)))
+      (bytevector-u16-set! b 0 44444 (endianness little))
+      (and (equal? (bytevector-u16-ref b 0 (endianness little))
+                   44444)
+           (equal? (bytevector-s16-ref b 0 (endianness little))
+                   (- 44444 65536)))))
+
+  (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
+    (let ((b (make-bytevector 2)))
+      (bytevector-u16-native-set! b 0 44444)
+      (and (equal? (bytevector-u16-native-ref b 0)
+                   44444)
+           (equal? (bytevector-s16-native-ref b 0)
+                   (- 44444 65536)))))
+
+  (pass-if "bytevector-s16-{ref,set!} [unaligned]"
+    (let ((b (make-bytevector 3)))
+      (bytevector-s16-set! b 1 -77 (endianness little))
+      (equal? (bytevector-s16-ref b 1 (endianness little))
+	      -77))))
+
+
+(with-test-prefix "2.6 Operations on 32-bit Integers"
+
+  (pass-if "bytevector-u32-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-u32-ref b 12 (endianness little))
+                   #xfdffffff)
+           (equal? (bytevector-u32-ref b 12 (endianness big))
+                   #xfffffffd))))
+
+  (pass-if "bytevector-s32-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-s32-ref b 12 (endianness little))
+                   -33554433)
+           (equal? (bytevector-s32-ref b 12 (endianness big))
+                   -3))))
+
+  (pass-if "bytevector-{u32,s32}-ref"
+    (let ((b (make-bytevector 4)))
+      (bytevector-u32-set! b 0 2222222222 (endianness little))
+      (and (equal? (bytevector-u32-ref b 0 (endianness little))
+                   2222222222)
+           (equal? (bytevector-s32-ref b 0 (endianness little))
+                   (- 2222222222 (expt 2 32))))))
+
+  (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
+    (let ((b (make-bytevector 4)))
+      (bytevector-u32-native-set! b 0 2222222222)
+      (and (equal? (bytevector-u32-native-ref b 0)
+                   2222222222)
+           (equal? (bytevector-s32-native-ref b 0)
+                   (- 2222222222 (expt 2 32)))))))
+
+
+(with-test-prefix "2.7 Operations on 64-bit Integers"
+
+  (pass-if "bytevector-u64-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-u64-ref b 8 (endianness little))
+                   #xfdffffffffffffff)
+           (equal? (bytevector-u64-ref b 8 (endianness big))
+                   #xfffffffffffffffd))))
+
+  (pass-if "bytevector-s64-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-s64-ref b 8 (endianness little))
+                   -144115188075855873)
+           (equal? (bytevector-s64-ref b 8 (endianness big))
+                   -3))))
+
+  (pass-if "bytevector-{u64,s64}-ref"
+    (let ((b (make-bytevector 8))
+          (big 9333333333333333333))
+      (bytevector-u64-set! b 0 big (endianness little))
+      (and (equal? (bytevector-u64-ref b 0 (endianness little))
+                   big)
+           (equal? (bytevector-s64-ref b 0 (endianness little))
+                   (- big (expt 2 64))))))
+
+  (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
+    (let ((b (make-bytevector 8))
+          (big 9333333333333333333))
+      (bytevector-u64-native-set! b 0 big)
+      (and (equal? (bytevector-u64-native-ref b 0)
+                   big)
+           (equal? (bytevector-s64-native-ref b 0)
+                   (- big (expt 2 64))))))
+
+  (pass-if "ref/set! with zero"
+     (let ((b (make-bytevector 8)))
+       (bytevector-s64-set! b 0 -1 (endianness big))
+       (bytevector-u64-set! b 0  0 (endianness big))
+       (= 0 (bytevector-u64-ref b 0 (endianness big))))))
+
+
+(with-test-prefix "2.8 Operations on IEEE-754 Representations"
+
+  (pass-if "bytevector-ieee-single-native-{ref,set!}"
+    (let ((b (make-bytevector 4))
+          (number 3.00))
+      (bytevector-ieee-single-native-set! b 0 number)
+      (equal? (bytevector-ieee-single-native-ref b 0)
+              number)))
+
+  (pass-if "bytevector-ieee-single-{ref,set!}"
+    (let ((b (make-bytevector 8))
+          (number 3.14))
+      (bytevector-ieee-single-set! b 0 number (endianness little))
+      (bytevector-ieee-single-set! b 4 number (endianness big))
+      (equal? (bytevector-ieee-single-ref b 0 (endianness little))
+              (bytevector-ieee-single-ref b 4 (endianness big)))))
+
+  (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
+    (let ((b (make-bytevector 9))
+          (number 3.14))
+      (bytevector-ieee-single-set! b 1 number (endianness little))
+      (bytevector-ieee-single-set! b 5 number (endianness big))
+      (equal? (bytevector-ieee-single-ref b 1 (endianness little))
+              (bytevector-ieee-single-ref b 5 (endianness big)))))
+
+  (pass-if "bytevector-ieee-double-native-{ref,set!}"
+    (let ((b (make-bytevector 8))
+          (number 3.14))
+      (bytevector-ieee-double-native-set! b 0 number)
+      (equal? (bytevector-ieee-double-native-ref b 0)
+              number)))
+
+  (pass-if "bytevector-ieee-double-{ref,set!}"
+    (let ((b (make-bytevector 16))
+          (number 3.14))
+      (bytevector-ieee-double-set! b 0 number (endianness little))
+      (bytevector-ieee-double-set! b 8 number (endianness big))
+      (equal? (bytevector-ieee-double-ref b 0 (endianness little))
+              (bytevector-ieee-double-ref b 8 (endianness big))))))
+
+
+(define (with-locale locale thunk)
+  ;; Run THUNK under LOCALE.
+  (let ((original-locale (setlocale LC_ALL)))
+    (catch 'system-error
+      (lambda ()
+        (setlocale LC_ALL locale))
+      (lambda (key . args)
+        (throw 'unresolved)))
+
+    (dynamic-wind
+        (lambda ()
+          #t)
+        thunk
+        (lambda ()
+          (setlocale LC_ALL original-locale)))))
+
+(define (with-latin1-locale thunk)
+  ;; Try out several ISO-8859-1 locales and run THUNK under the one that
+  ;; works (if any).
+  (define %locales
+    (map (lambda (name)
+           (string-append name ".ISO-8859-1"))
+         '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
+
+  (let loop ((locales %locales))
+    (if (null? locales)
+        (throw 'unresolved)
+        (catch 'unresolved
+          (lambda ()
+            (with-locale (car locales) thunk))
+          (lambda (key . args)
+            (loop (cdr locales)))))))
+
+
+;; Default to the C locale for the following tests.
+(setlocale LC_ALL "C")
+
+
+(with-test-prefix "2.9 Operations on Strings"
+
+  (pass-if "string->utf8"
+    (let* ((str  "hello, world")
+           (utf8 (string->utf8 str)))
+      (and (bytevector? utf8)
+           (= (bytevector-length utf8)
+              (string-length str))
+           (equal? (string->list str)
+                   (map integer->char (bytevector->u8-list utf8))))))
+
+  (pass-if "string->utf8 [latin-1]"
+    (with-latin1-locale
+      (lambda ()
+        (let* ((str  "hé, ça va bien ?")
+               (utf8 (string->utf8 str)))
+          (and (bytevector? utf8)
+               (= (bytevector-length utf8)
+                  (+ 2 (string-length str))))))))
+
+  (pass-if "string->utf16"
+    (let* ((str   "hello, world")
+           (utf16 (string->utf16 str)))
+      (and (bytevector? utf16)
+           (= (bytevector-length utf16)
+              (* 2 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16
+                                               (endianness big) 2))))))
+
+  (pass-if "string->utf16 [little]"
+    (let* ((str   "hello, world")
+           (utf16 (string->utf16 str (endianness little))))
+      (and (bytevector? utf16)
+           (= (bytevector-length utf16)
+              (* 2 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16
+                                               (endianness little) 2))))))
+
+
+  (pass-if "string->utf32"
+    (let* ((str   "hello, world")
+           (utf32 (string->utf32 str)))
+      (and (bytevector? utf32)
+           (= (bytevector-length utf32)
+              (* 4 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32
+                                               (endianness big) 4))))))
+
+  (pass-if "string->utf32 [little]"
+    (let* ((str   "hello, world")
+           (utf32 (string->utf32 str (endianness little))))
+      (and (bytevector? utf32)
+           (= (bytevector-length utf32)
+              (* 4 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32
+                                               (endianness little) 4))))))
+
+  (pass-if "utf8->string"
+    (let* ((utf8  (u8-list->bytevector (map char->integer
+                                            (string->list "hello, world"))))
+           (str   (utf8->string utf8)))
+      (and (string? str)
+           (= (string-length str)
+              (bytevector-length utf8))
+           (equal? (string->list str)
+                   (map integer->char (bytevector->u8-list utf8))))))
+
+  (pass-if "utf8->string [latin-1]"
+    (with-latin1-locale
+      (lambda ()
+        (let* ((utf8  (string->utf8 "hé, ça va bien ?"))
+               (str   (utf8->string utf8)))
+          (and (string? str)
+               (= (string-length str)
+                  (- (bytevector-length utf8) 2)))))))
+
+  (pass-if "utf16->string"
+    (let* ((utf16  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness big) 2))
+           (str   (utf16->string utf16)))
+      (and (string? str)
+           (= (* 2 (string-length str))
+              (bytevector-length utf16))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16 (endianness big)
+                                               2))))))
+
+  (pass-if "utf16->string [little]"
+    (let* ((utf16  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness little) 2))
+           (str   (utf16->string utf16 (endianness little))))
+      (and (string? str)
+           (= (* 2 (string-length str))
+              (bytevector-length utf16))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16 (endianness little)
+                                               2))))))
+  (pass-if "utf32->string"
+    (let* ((utf32  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness big) 4))
+           (str   (utf32->string utf32)))
+      (and (string? str)
+           (= (* 4 (string-length str))
+              (bytevector-length utf32))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32 (endianness big)
+                                               4))))))
+
+  (pass-if "utf32->string [little]"
+    (let* ((utf32  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness little) 4))
+           (str   (utf32->string utf32 (endianness little))))
+      (and (string? str)
+           (= (* 4 (string-length str))
+              (bytevector-length utf32))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32 (endianness little)
+                                               4)))))))
+
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; mode: scheme
+;;; End:
diff --git a/test-suite/tests/elisp.test b/test-suite/tests/elisp.test
index eaf6dbbff..9e0997087 100644
--- a/test-suite/tests/elisp.test
+++ b/test-suite/tests/elisp.test
@@ -23,6 +23,9 @@
 (if *old-stack-level*
     (debug-set! stack (* 2 *old-stack-level*)))
 
+(define *old-%load-should-autocompile* %load-should-autocompile)
+(set! %load-should-autocompile #f)
+
 ;;;
 ;;; elisp
 ;;;
@@ -350,6 +353,7 @@
 
       ))
 
+(set! %load-should-autocompile *old-%load-should-autocompile*)
 (debug-set! stack *old-stack-level*)
 
 ;;; elisp.test ends here
diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 08bfa7cb4..9cc68f21c 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -77,7 +77,7 @@
     (let* ((p2c (pipe))
            (port (with-input-from-port (car p2c)
                    (lambda ()
-                     (open-input-pipe "read && echo $REPLY")))))
+                     (open-input-pipe "read line && echo $line")))))
       (display "hello\n" (cdr p2c))
       (force-output (cdr p2c))
       (let ((result (eq? (read port) 'hello)))
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
new file mode 100644
index 000000000..204f37144
--- /dev/null
+++ b/test-suite/tests/r6rs-ports.test
@@ -0,0 +1,455 @@
+;;;; r6rs-ports.test --- Exercise the R6RS I/O port API.
+;;;;
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Ludovic Courtès
+;;;;
+;;;; 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 2.1 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
+
+(define-module (test-io-ports)
+  :use-module (test-suite lib)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-11)
+  :use-module (rnrs io ports)
+  :use-module (rnrs bytevector))
+
+;;; All these tests assume Guile 1.8's port system, where characters are
+;;; treated as octets.
+
+
+(with-test-prefix "7.2.5 End-of-File Object"
+
+  (pass-if "eof-object"
+    (and (eqv? (eof-object) (eof-object))
+         (eq?  (eof-object) (eof-object)))))
+
+
+(with-test-prefix "7.2.8 Binary Input"
+
+  (pass-if "get-u8"
+    (let ((port (open-input-string "A")))
+      (and (= (char->integer #\A) (get-u8 port))
+           (eof-object? (get-u8 port)))))
+
+  (pass-if "lookahead-u8"
+    (let ((port (open-input-string "A")))
+      (and (= (char->integer #\A) (lookahead-u8 port))
+           (not (eof-object? port))
+           (= (char->integer #\A) (get-u8 port))
+           (eof-object? (get-u8 port)))))
+
+  (pass-if "get-bytevector-n [short]"
+    (let* ((port (open-input-string "GNU Guile"))
+           (bv (get-bytevector-n port 4)))
+      (and (bytevector? bv)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU "))))))
+
+  (pass-if "get-bytevector-n [long]"
+    (let* ((port (open-input-string "GNU Guile"))
+           (bv (get-bytevector-n port 256)))
+      (and (bytevector? bv)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU Guile"))))))
+
+  (pass-if-exception "get-bytevector-n with closed port"
+    exception:wrong-type-arg
+
+    (let ((port (%make-void-port "r")))
+
+      (close-port port)
+      (get-bytevector-n port 3)))
+
+  (pass-if "get-bytevector-n! [short]"
+    (let* ((port (open-input-string "GNU Guile"))
+           (bv   (make-bytevector 4))
+           (read (get-bytevector-n! port bv 0 4)))
+      (and (equal? read 4)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU "))))))
+
+  (pass-if "get-bytevector-n! [long]"
+    (let* ((str  "GNU Guile")
+           (port (open-input-string str))
+           (bv   (make-bytevector 256))
+           (read (get-bytevector-n! port bv 0 256)))
+      (and (equal? read (string-length str))
+           (equal? (map (lambda (i)
+                          (bytevector-u8-ref bv i))
+                        (iota read))
+                   (map char->integer (string->list str))))))
+
+  (pass-if "get-bytevector-some [simple]"
+    (let* ((str  "GNU Guile")
+           (port (open-input-string str))
+           (bv   (get-bytevector-some port)))
+      (and (bytevector? bv)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list str))))))
+
+  (pass-if "get-bytevector-some [only-some]"
+    (let* ((str   "GNU Guile")
+           (index 0)
+           (port  (make-soft-port
+                   (vector #f #f #f
+                           (lambda ()
+                             (if (>= index (string-length str))
+                                 (eof-object)
+                                 (let ((c (string-ref str index)))
+                                   (set! index (+ index 1))
+                                   c)))
+                           (lambda () #t)
+                           (lambda ()
+                             ;; Number of readily available octets: falls to
+                             ;; zero after 4 octets have been read.
+                             (- 4 (modulo index 5))))
+                   "r"))
+           (bv    (get-bytevector-some port)))
+      (and (bytevector? bv)
+           (= index 4)
+           (= (bytevector-length bv) index)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU "))))))
+
+  (pass-if "get-bytevector-all"
+    (let* ((str   "GNU Guile")
+           (index 0)
+           (port  (make-soft-port
+                   (vector #f #f #f
+                           (lambda ()
+                             (if (>= index (string-length str))
+                                 (eof-object)
+                                 (let ((c (string-ref str index)))
+                                   (set! index (+ index 1))
+                                   c)))
+                           (lambda () #t)
+                           (let ((cont? #f))
+                             (lambda ()
+                               ;; Number of readily available octets: falls to
+                               ;; zero after 4 octets have been read and then
+                               ;; starts again.
+                               (let ((a (if cont?
+                                            (- (string-length str) index)
+                                            (- 4 (modulo index 5)))))
+                                 (if (= 0 a) (set! cont? #t))
+                                 a))))
+                   "r"))
+           (bv    (get-bytevector-all port)))
+      (and (bytevector? bv)
+           (= index (string-length str))
+           (= (bytevector-length bv) (string-length str))
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list str)))))))
+
+
+(define (make-soft-output-port)
+  (let* ((bv (make-bytevector 1024))
+         (read-index  0)
+         (write-index 0)
+         (write-char (lambda (chr)
+                       (bytevector-u8-set! bv write-index
+                                           (char->integer chr))
+                       (set! write-index (+ 1 write-index)))))
+    (make-soft-port
+     (vector write-char
+             (lambda (str)   ;; write-string
+               (for-each write-char (string->list str)))
+             (lambda () #t)  ;; flush-output
+             (lambda ()      ;; read-char
+               (if (>= read-index (bytevector-length bv))
+                   (eof-object)
+                   (let ((c (bytevector-u8-ref bv read-index)))
+                     (set! read-index (+ read-index 1))
+                     (integer->char c))))
+             (lambda () #t)) ;; close-port
+     "rw")))
+
+(with-test-prefix "7.2.11 Binary Output"
+
+  (pass-if "put-u8"
+    (let ((port (make-soft-output-port)))
+      (put-u8 port 77)
+      (equal? (get-u8 port) 77)))
+
+  (pass-if "put-bytevector [2 args]"
+    (let ((port (make-soft-output-port))
+          (bv   (make-bytevector 256)))
+      (put-bytevector port bv)
+      (equal? (bytevector->u8-list bv)
+              (bytevector->u8-list
+               (get-bytevector-n port (bytevector-length bv))))))
+
+  (pass-if "put-bytevector [3 args]"
+    (let ((port  (make-soft-output-port))
+          (bv    (make-bytevector 256))
+          (start 10))
+      (put-bytevector port bv start)
+      (equal? (drop (bytevector->u8-list bv) start)
+              (bytevector->u8-list
+               (get-bytevector-n port (- (bytevector-length bv) start))))))
+
+  (pass-if "put-bytevector [4 args]"
+    (let ((port  (make-soft-output-port))
+          (bv    (make-bytevector 256))
+          (start 10)
+          (count 77))
+      (put-bytevector port bv start count)
+      (equal? (take (drop (bytevector->u8-list bv) start) count)
+              (bytevector->u8-list
+               (get-bytevector-n port count)))))
+
+  (pass-if-exception "put-bytevector with closed port"
+    exception:wrong-type-arg
+
+    (let* ((bv   (make-bytevector 4))
+           (port (%make-void-port "w")))
+
+      (close-port port)
+      (put-bytevector port bv))))
+
+
+(with-test-prefix "7.2.7 Input Ports"
+
+  ;; This section appears here so that it can use the binary input
+  ;; primitives.
+
+  (pass-if "open-bytevector-input-port [1 arg]"
+    (let* ((str "Hello Port!")
+           (bv (u8-list->bytevector (map char->integer
+                                         (string->list str))))
+           (port (open-bytevector-input-port bv))
+           (read-to-string
+            (lambda (port)
+              (let loop ((chr (read-char port))
+                         (result '()))
+                (if (eof-object? chr)
+                    (apply string (reverse! result))
+                    (loop (read-char port)
+                          (cons chr result)))))))
+
+      (equal? (read-to-string port) str)))
+
+  (pass-if-exception "bytevector-input-port is read-only"
+    exception:wrong-type-arg
+
+    (let* ((str "Hello Port!")
+           (bv (u8-list->bytevector (map char->integer
+                                         (string->list str))))
+           (port (open-bytevector-input-port bv #f)))
+
+      (write "hello" port)))
+
+  (pass-if "bytevector input port supports seeking"
+    (let* ((str "Hello Port!")
+           (bv (u8-list->bytevector (map char->integer
+                                         (string->list str))))
+           (port (open-bytevector-input-port bv #f)))
+
+      (and (port-has-port-position? port)
+           (= 0 (port-position port))
+           (port-has-set-port-position!? port)
+           (begin
+             (set-port-position! port 6)
+             (= 6 (port-position port)))
+           (bytevector=? (get-bytevector-all port)
+                         (u8-list->bytevector
+                          (map char->integer (string->list "Port!")))))))
+
+  (pass-if-exception "make-custom-binary-input-port [wrong-num-args]"
+    exception:wrong-num-args
+
+    ;; Prior to Guile-R6RS-Libs 0.2, the last 3 arguments were wrongfully
+    ;; optional.
+    (make-custom-binary-input-port "port" (lambda args #t)))
+
+  (pass-if "make-custom-binary-input-port"
+    (let* ((source (make-bytevector 7777))
+           (read! (let ((pos 0)
+                        (len (bytevector-length source)))
+                    (lambda (bv start count)
+                      (let ((amount (min count (- len pos))))
+                        (if (> amount 0)
+                            (bytevector-copy! source pos
+                                              bv start amount))
+                        (set! pos (+ pos amount))
+                        amount))))
+           (port (make-custom-binary-input-port "the port" read!
+                                                #f #f #f)))
+
+      (bytevector=? (get-bytevector-all port) source)))
+
+  (pass-if "custom binary input port does not support `port-position'"
+    (let* ((str "Hello Port!")
+           (source (open-bytevector-input-port
+                    (u8-list->bytevector
+                     (map char->integer (string->list str)))))
+           (read! (lambda (bv start count)
+                    (let ((r (get-bytevector-n! source bv start count)))
+                      (if (eof-object? r)
+                          0
+                          r))))
+           (port (make-custom-binary-input-port "the port" read!
+                                                #f #f #f)))
+      (not (or (port-has-port-position? port)
+               (port-has-set-port-position!? port)))))
+
+  (pass-if "custom binary input port supports `port-position'"
+    (let* ((str "Hello Port!")
+           (source (open-bytevector-input-port
+                    (u8-list->bytevector
+                     (map char->integer (string->list str)))))
+           (read! (lambda (bv start count)
+                    (let ((r (get-bytevector-n! source bv start count)))
+                      (if (eof-object? r)
+                          0
+                          r))))
+           (get-pos (lambda ()
+                      (port-position source)))
+           (set-pos! (lambda (pos)
+                       (set-port-position! source pos)))
+           (port (make-custom-binary-input-port "the port" read!
+                                                get-pos set-pos! #f)))
+
+      (and (port-has-port-position? port)
+           (= 0 (port-position port))
+           (port-has-set-port-position!? port)
+           (begin
+             (set-port-position! port 6)
+             (= 6 (port-position port)))
+           (bytevector=? (get-bytevector-all port)
+                         (u8-list->bytevector
+                          (map char->integer (string->list "Port!")))))))
+
+  (pass-if "custom binary input port `close-proc' is called"
+    (let* ((closed?  #f)
+           (read!    (lambda (bv start count) 0))
+           (get-pos  (lambda () 0))
+           (set-pos! (lambda (pos) #f))
+           (close!   (lambda () (set! closed? #t)))
+           (port     (make-custom-binary-input-port "the port" read!
+                                                    get-pos set-pos!
+                                                    close!)))
+
+      (close-port port)
+      closed?)))
+
+
+(with-test-prefix "8.2.10 Output ports"
+
+  (pass-if "open-bytevector-output-port"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port #f)))
+      (let ((source (make-bytevector 7777)))
+        (put-bytevector port source)
+        (and (bytevector=? (get-content) source)
+             (bytevector=? (get-content) (make-bytevector 0))))))
+
+  (pass-if "open-bytevector-output-port [put-u8]"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port)))
+      (put-u8 port 77)
+      (and (bytevector=? (get-content) (make-bytevector 1 77))
+           (bytevector=? (get-content) (make-bytevector 0)))))
+
+  (pass-if "open-bytevector-output-port [display]"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port)))
+      (display "hello" port)
+      (and (bytevector=? (get-content) (string->utf8 "hello"))
+           (bytevector=? (get-content) (make-bytevector 0)))))
+
+  (pass-if "bytevector output port supports `port-position'"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port)))
+      (let ((source (make-bytevector 7777))
+            (overwrite (make-bytevector 33)))
+        (and (port-has-port-position? port)
+             (port-has-set-port-position!? port)
+             (begin
+               (put-bytevector port source)
+               (= (bytevector-length source)
+                  (port-position port)))
+             (begin
+               (set-port-position! port 10)
+               (= 10 (port-position port)))
+             (begin
+               (put-bytevector port overwrite)
+               (bytevector-copy! overwrite 0 source 10
+                                 (bytevector-length overwrite))
+               (= (port-position port)
+                  (+ 10 (bytevector-length overwrite))))
+             (bytevector=? (get-content) source)
+             (bytevector=? (get-content) (make-bytevector 0))))))
+
+  (pass-if "make-custom-binary-output"
+    (let ((port (make-custom-binary-output-port "cbop"
+                                                (lambda (x y z) 0)
+                                                #f #f #f)))
+      (and (output-port? port)
+           (binary-port? port)
+           (not (port-has-port-position? port))
+           (not (port-has-set-port-position!? port)))))
+
+  (pass-if "make-custom-binary-output-port [partial writes]"
+    (let* ((source   (uint-list->bytevector (iota 333)
+                                            (native-endianness) 2))
+           (sink     (make-bytevector (bytevector-length source)))
+           (sink-pos 0)
+           (eof?     #f)
+           (write!   (lambda (bv start count)
+                       (if (= 0 count)
+                           (begin
+                             (set! eof? #t)
+                             0)
+                           (let ((u8 (bytevector-u8-ref bv start)))
+                             ;; Get one byte at a time.
+                             (bytevector-u8-set! sink sink-pos u8)
+                             (set! sink-pos (+ 1 sink-pos))
+                             1))))
+           (port     (make-custom-binary-output-port "cbop" write!
+                                                     #f #f #f)))
+      (put-bytevector port source)
+      (and (= sink-pos (bytevector-length source))
+           (not eof?)
+           (bytevector=? sink source))))
+
+  (pass-if "make-custom-binary-output-port [full writes]"
+    (let* ((source   (uint-list->bytevector (iota 333)
+                                            (native-endianness) 2))
+           (sink     (make-bytevector (bytevector-length source)))
+           (sink-pos 0)
+           (eof?     #f)
+           (write!   (lambda (bv start count)
+                       (if (= 0 count)
+                           (begin
+                             (set! eof? #t)
+                             0)
+                           (begin
+                             (bytevector-copy! bv start
+                                               sink sink-pos
+                                               count)
+                             (set! sink-pos (+ sink-pos count))
+                             count))))
+           (port     (make-custom-binary-output-port "cbop" write!
+                                                     #f #f #f)))
+      (put-bytevector port source)
+      (and (= sink-pos (bytevector-length source))
+           (not eof?)
+           (bytevector=? sink source)))))
+
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; mode: scheme
+;;; End:
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 0b6f9a468..bd34e4db0 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -35,6 +35,8 @@
   (cons 'read-error "end of file in string constant$"))
 (define exception:illegal-escape
   (cons 'read-error "illegal character in escape sequence: .*$"))
+(define exception:missing-expression
+  (cons 'read-error "no expression after #;"))
 
 
 (define (read-string s)
@@ -194,3 +196,36 @@
       (and (equal? (source-property sexp 'line) 0)
            (equal? (source-property sexp 'column) 0)))))
 
+(with-test-prefix "#;"
+  (for-each
+   (lambda (pair)
+     (pass-if (car pair)
+       (equal? (with-input-from-string (car pair) read) (cdr pair))))
+
+   '(("#;foo 10". 10)
+     ("#;(10 20 30) foo" . foo)
+     ("#;   (10 20 30) foo" . foo)
+     ("#;\n10\n20" . 20)))
+  
+  (pass-if "#;foo"
+    (eof-object? (with-input-from-string "#;foo" read)))
+  
+  (pass-if-exception "#;"
+    exception:missing-expression
+    (with-input-from-string "#;" read))
+  (pass-if-exception "#;("
+    exception:eof
+    (with-input-from-string "#;(" read)))
+
+(with-test-prefix "#'"
+  (for-each
+   (lambda (pair)
+     (pass-if (car pair)
+       (equal? (with-input-from-string (car pair) read) (cdr pair))))
+
+   '(("#'foo". (syntax foo))
+     ("#`foo" . (quasisyntax foo))
+     ("#,foo" . (unsyntax foo))
+     ("#,@foo" . (unsyntax-splicing foo)))))
+
+
diff --git a/test-suite/tests/srfi-98.test b/test-suite/tests/srfi-98.test
new file mode 100644
index 000000000..3fbb1ef03
--- /dev/null
+++ b/test-suite/tests/srfi-98.test
@@ -0,0 +1,38 @@
+;;;; srfi-98.test --- Test suite for Guile's SRFI-98 functions. -*- scheme -*-
+;;;;
+;;;; Copyright 2009 Free Software Foundation, Inc.
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, 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 General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this software; see the file COPYING.  If not, write to
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
+
+(define-module (test-srfi-98)
+  #:use-module (srfi srfi-98)
+  #:use-module (test-suite lib))
+
+(with-test-prefix "get-environment-variable"
+  (pass-if "get-environment-variable retrieves binding"
+    (putenv "foo=bar")
+    (equal? (get-environment-variable "foo") "bar"))
+
+  (pass-if "get-environment-variable #f on unbound name"
+    (unsetenv "foo")
+    (not (get-environment-variable "foo"))))      
+
+(with-test-prefix "get-environment-variables"
+
+  (pass-if "get-environment-variables contains binding"
+    (putenv "foo=bar")
+    (equal? (assoc-ref (get-environment-variables) "foo") "bar")))
+