Merge remote-tracking branch 'origin/stable-2.0'

Moved scm_i_struct_hash from struct.c to hash.c and made it static.

The port's alist is now a field of 'scm_t_port'.

Conflicts:
	libguile/arrays.c
	libguile/hash.c
	libguile/ports.c
	libguile/print.h
	libguile/read.c

53 files changed, 1676 insertions, 530 deletions

diff --git a/THANKS b/THANKS
index a3d15defa..2dbf570eb 100644
--- a/THANKS
+++ b/THANKS
@@ -6,6 +6,7 @@ Contributors since the last release:
          Volker Grabsch
          Julian Graham
         Michael Gran
+         Daniel Hartwig
              No Itisnt
            Neil Jerram
          Daniel Kraft
diff --git a/configure.ac b/configure.ac
index ab4e147aa..8adfd471c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -36,7 +36,7 @@ AC_CONFIG_MACRO_DIR([m4])
 AC_CONFIG_SRCDIR(GUILE-VERSION)
 
 dnl `AM_SUBST_NOTMAKE' was introduced in Automake 1.11.
-AM_INIT_AUTOMAKE([1.11 gnu no-define -Wall -Wno-override dist-xz])
+AM_INIT_AUTOMAKE([1.11 gnu no-define -Wall -Wno-override color-tests dist-xz])
 m4_ifdef([AM_SILENT_RULES], [AM_SILENT_RULES([yes])], [AC_SUBST([AM_DEFAULT_VERBOSITY],1)])
 
 AC_COPYRIGHT(GUILE_CONFIGURE_COPYRIGHT)
diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am
index abe9cb9ee..201ab6b3f 100644
--- a/doc/ref/Makefile.am
+++ b/doc/ref/Makefile.am
@@ -62,6 +62,7 @@ guile_TEXINFOS = preface.texi			\
 		 web.texi			\
 		 expect.texi			\
 		 scsh.texi			\
+		 curried.texi			\
 		 sxml-match.texi		\
 		 scheme-scripts.texi		\
 		 api-overview.texi		\
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 39c97909a..6d8de2bd6 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -3152,12 +3152,24 @@ These procedures are useful for similar tasks.
 Convert the string @var{str} into a list of characters.
 @end deffn
 
-@deffn {Scheme Procedure} string-split str chr
-@deffnx {C Function} scm_string_split (str, chr)
+@deffn {Scheme Procedure} string-split str char_pred
+@deffnx {C Function} scm_string_split (str, char_pred)
 Split the string @var{str} into a list of substrings delimited
-by appearances of the character @var{chr}.  Note that an empty substring
-between separator characters will result in an empty string in the
-result list.
+by appearances of characters that
+
+@itemize @bullet
+@item
+equal @var{char_pred}, if it is a character,
+
+@item
+satisfy the predicate @var{char_pred}, if it is a procedure,
+
+@item
+are in the set @var{char_pred}, if it is a character set.
+@end itemize
+
+Note that an empty substring between separator characters will result in
+an empty string in the result list.
 
 @lisp
 (string-split "root:x:0:0:root:/root:/bin/bash" #\:)
diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 611283225..c471f643b 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -254,6 +254,8 @@ Encoding of Source Files}.
 
 @node Case Sensitivity
 @subsubsection Case Sensitivity
+@cindex fold-case
+@cindex no-fold-case
 
 @c FIXME::martin: Review me!
 
@@ -275,9 +277,9 @@ options, @xref{Scheme Read}.
 (read-enable 'case-insensitive)
 @end lisp
 
-Note that this is seldom a problem, because Scheme programmers tend not
-to use uppercase letters in their identifiers anyway.
-
+It is also possible to disable (or enable) case sensitivity within a
+single file by placing the reader directives @code{#!fold-case} (or
+@code{#!no-fold-case}) within the file itself.
 
 @node Keyword Syntax
 @subsubsection Keyword Syntax
@@ -315,10 +317,10 @@ its read options.
 @cindex options - read
 @cindex read options
 @deffn {Scheme Procedure} read-options [setting]
-Display the current settings of the read options.  If @var{setting} is
-omitted, only a short form of the current read options is printed.
-Otherwise if @var{setting} is the symbol @code{help}, a complete options
-description is displayed.
+Display the current settings of the global read options.  If
+@var{setting} is omitted, only a short form of the current read options
+is printed.  Otherwise if @var{setting} is the symbol @code{help}, a
+complete options description is displayed.
 @end deffn
 
 The set of available options, and their default values, may be had by
@@ -336,8 +338,19 @@ r6rs-hex-escapes  no    Use R6RS variable-length character and string hex escape
 square-brackets   yes   Treat `[' and `]' as parentheses, for R6RS compatibility.
 hungry-eol-escapes no   In strings, consume leading whitespace after an
                         escaped end-of-line.
+curly-infix       no    Support SRFI-105 curly infix expressions.
 @end smalllisp
 
+Note that Guile also includes a preliminary mechanism for setting read
+options on a per-port basis.  For instance, the @code{case-insensitive}
+read option is set (or unset) on the port when the reader encounters the
+@code{#!fold-case} or @code{#!no-fold-case} reader directives.
+Similarly, the @code{#!curly-infix} reader directive sets the
+@code{curly-infix} read option on the port, and
+@code{#!curly-infix-and-bracket-lists} sets @code{curly-infix} and
+unsets @code{square-brackets} on the port (@pxref{SRFI-105}).  There is
+currently no other way to access or set the per-port read options.
+
 The boolean options may be toggled with @code{read-enable} and
 @code{read-disable}. The non-boolean @code{keywords} option must be set
 using @code{read-set!}.
diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi
index f63597824..173431890 100644
--- a/doc/ref/api-options.texi
+++ b/doc/ref/api-options.texi
@@ -390,6 +390,7 @@ r6rs-hex-escapes  no    Use R6RS variable-length character and string hex escape
 square-brackets   yes   Treat `[' and `]' as parentheses, for R6RS compatibility.
 hungry-eol-escapes no   In strings, consume leading whitespace after an
                         escaped end-of-line.
+curly-infix       no    Support SRFI-105 curly infix expressions.
 scheme@@(guile-user) [1]> (read-enable 'case-insensitive)
 $2 = (square-brackets keywords #f case-insensitive positions)
 scheme@@(guile-user) [1]> ,q
diff --git a/doc/ref/api-regex.texi b/doc/ref/api-regex.texi
index 11a31fca0..082fb874d 100644
--- a/doc/ref/api-regex.texi
+++ b/doc/ref/api-regex.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009, 2010
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009, 2010, 2012
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -54,11 +54,12 @@ Zero bytes (@code{#\nul}) cannot be used in regex patterns or input
 strings, since the underlying C functions treat that as the end of
 string.  If there's a zero byte an error is thrown.
 
-Patterns and input strings are treated as being in the locale
-character set if @code{setlocale} has been called (@pxref{Locales}),
-and in a multibyte locale this includes treating multi-byte sequences
-as a single character.  (Guile strings are currently merely bytes,
-though this may change in the future, @xref{Conversion to/from C}.)
+Internally, patterns and input strings are converted to the current
+locale's encoding, and then passed to the C library's regular expression
+routines (@pxref{Regular Expressions,,, libc, The GNU C Library
+Reference Manual}).  The returned match structures always point to
+characters in the strings, not to individual bytes, even in the case of
+multi-byte encodings.
 
 @deffn {Scheme Procedure} string-match pattern str [start]
 Compile the string @var{pattern} into a regular expression and compare
diff --git a/doc/ref/curried.texi b/doc/ref/curried.texi
new file mode 100644
index 000000000..25430b4f0
--- /dev/null
+++ b/doc/ref/curried.texi
@@ -0,0 +1,56 @@
+@c -*-texinfo-*-
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C) 2012 Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
+
+@node Curried Definitions
+@section Curried Definitions
+
+The macros in this section are provided by
+@lisp
+(use-modules (ice-9 curried-definitions))
+@end lisp
+@noindent
+and replace those provided by default.
+
+Prior to Guile 2.0, Guile provided a type of definition known colloquially
+as a ``curried definition''. The idea is to extend the syntax of
+@code{define} so that you can conveniently define procedures that return
+procedures, up to any desired depth.
+
+For example,
+@example
+(define ((foo x) y)
+  (list x y))
+@end example
+is a convenience form of
+@example
+(define foo
+  (lambda (x)
+    (lambda (y)
+      (list x y))))
+@end example
+
+@deffn {Scheme Syntax} define (@dots{} (name args @dots{}) @dots{}) body @dots{}
+@deffnx {Scheme Syntax} define* (@dots{} (name args @dots{}) @dots{}) body @dots{}
+@deffnx {Scheme Syntax} define-public (@dots{} (name args @dots{}) @dots{}) body @dots{}
+
+Create a top level variable @var{name} bound to the procedure with
+parameter list @var{args}. If @var{name} is itself a formal parameter
+list, then a higher order procedure is created using that
+formal-parameter list, and returning a procedure that has parameter list
+@var{args}. This nesting may occur to arbitrary depth.
+
+@code{define*} is similar but the formal parameter lists take additional
+options as described in @ref{lambda* and define*}. For example,
+@example
+(define* ((foo #:keys (bar 'baz) (quux 'zot)) frotz #:rest rest)
+  (list bar quux frotz rest))
+
+((foo #:quux 'foo) 1 2 3 4 5)
+@result{} (baz foo 1 (2 3 4 5))
+@end example
+
+@code{define-public} is similar to @code{define} but it also adds
+@var{name} to the list of exported bindings of the current module.
+@end deffn
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index c3da0c36d..a1b3fe60c 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -370,6 +370,7 @@ available through both Scheme and C interfaces.
 * Expect::			Controlling interactive programs with Guile.
 * sxml-match::                  Pattern matching of SXML.
 * The Scheme shell (scsh)::     Using scsh interfaces in Guile.
+* Curried Definitions::         Extended @code{define} syntax.
 @end menu
 
 @include slib.texi
@@ -387,6 +388,7 @@ available through both Scheme and C interfaces.
 @include sxml-match.texi
 
 @include scsh.texi
+@include curried.texi
 
 @node Standard Library
 @chapter Standard Library
diff --git a/doc/ref/scheme-ideas.texi b/doc/ref/scheme-ideas.texi
index 53f7b6132..15cf6640d 100644
--- a/doc/ref/scheme-ideas.texi
+++ b/doc/ref/scheme-ideas.texi
@@ -476,6 +476,11 @@ The corresponding forms of the alternative @code{define} syntax are:
 @noindent
 For details on how these forms work, see @xref{Lambda}.
 
+Prior to Guile 2.0, Guile provided an extension to @code{define} syntax
+that allowed you to nest the previous extension up to an arbitrary
+depth. These are no longer provided by default, and instead have been
+moved to @ref{Curried Definitions}
+
 (It could be argued that the alternative @code{define} forms are rather
 confusing, especially for newcomers to the Scheme language, as they hide
 both the role of @code{lambda} and the fact that procedures are values
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index 3d439132b..7eb84de0a 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -457,7 +457,7 @@ show a short error printout.
 Default values for REPL options may be set using
 @code{repl-default-option-set!} from @code{(system repl common)}:
 
-@deffn {Scheme Procedure} repl-set-default-option! key value
+@deffn {Scheme Procedure} repl-default-option-set! key value
 Set the default value of a REPL option.  This function is particularly
 useful in a user's init file.  @xref{Init File}.
 @end deffn
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 29c1e06f5..da1b86fe0 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -54,6 +54,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-69::                     Basic hash tables.
 * SRFI-88::                     Keyword objects.
 * SRFI-98::                     Accessing environment variables.
+* SRFI-105::                    Curly-infix expressions.
 @end menu
 
 
@@ -3003,10 +3004,10 @@ with locale decimal point, eg.@: @samp{5.2}
 @item @nicode{~z} @tab time zone, RFC-822 style
 @item @nicode{~Z} @tab time zone symbol (not currently implemented)
 @item @nicode{~1} @tab ISO-8601 date, @samp{~Y-~m-~d}
-@item @nicode{~2} @tab ISO-8601 time+zone, @samp{~k:~M:~S~z}
-@item @nicode{~3} @tab ISO-8601 time, @samp{~k:~M:~S}
-@item @nicode{~4} @tab ISO-8601 date/time+zone, @samp{~Y-~m-~dT~k:~M:~S~z}
-@item @nicode{~5} @tab ISO-8601 date/time, @samp{~Y-~m-~dT~k:~M:~S}
+@item @nicode{~2} @tab ISO-8601 time+zone, @samp{~H:~M:~S~z}
+@item @nicode{~3} @tab ISO-8601 time, @samp{~H:~M:~S}
+@item @nicode{~4} @tab ISO-8601 date/time+zone, @samp{~Y-~m-~dT~H:~M:~S~z}
+@item @nicode{~5} @tab ISO-8601 date/time, @samp{~Y-~m-~dT~H:~M:~S}
 @end multitable
 @end defun
 
@@ -4469,6 +4470,56 @@ 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
 
+@node SRFI-105
+@subsection SRFI-105 Curly-infix expressions.
+@cindex SRFI-105
+@cindex curly-infix
+@cindex curly-infix-and-bracket-lists
+
+Guile's built-in reader includes support for SRFI-105 curly-infix
+expressions.  See @uref{http://srfi.schemers.org/srfi-105/srfi-105.html,
+the specification of SRFI-105}.  Some examples:
+
+@example
+@{n <= 5@}                @result{}  (<= n 5)
+@{a + b + c@}             @result{}  (+ a b c)
+@{a * @{b + c@}@}           @result{}  (* a (+ b c))
+@{(- a) / b@}             @result{}  (/ (- a) b)
+@{-(a) / b@}              @result{}  (/ (- a) b) as well
+@{(f a b) + (g h)@}       @result{}  (+ (f a b) (g h))
+@{f(a b) + g(h)@}         @result{}  (+ (f a b) (g h)) as well
+@{f[a b] + g(h)@}         @result{}  (+ ($bracket-apply$ f a b) (g h))
+'@{a + f(b) + x@}         @result{}  '(+ a (f b) x)
+@{length(x) >= 6@}        @result{}  (>= (length x) 6)
+@{n-1 + n-2@}             @result{}  (+ n-1 n-2)
+@{n * factorial@{n - 1@}@}  @result{}  (* n (factorial (- n 1)))
+@{@{a > 0@} and @{b >= 1@}@}  @result{}  (and (> a 0) (>= b 1))
+@{f@{n - 1@}(x)@}           @result{}  ((f (- n 1)) x)
+@{a . z@}                 @result{}  ($nfx$ a . z)
+@{a + b - c@}             @result{}  ($nfx$ a + b - c)
+@end example
+
+To enable curly-infix expressions within a file, place the reader
+directive @code{#!curly-infix} before the first use of curly-infix
+notation.  To globally enable curly-infix expressions in Guile's reader,
+set the @code{curly-infix} read option.
+
+Guile also implements the following non-standard extension to SRFI-105:
+if @code{curly-infix} is enabled and there is no other meaning assigned
+to square brackets (i.e. the @code{square-brackets} read option is
+turned off), then lists within square brackets are read as normal lists
+but with the special symbol @code{$bracket-list$} added to the front.
+To enable this combination of read options within a file, use the reader
+directive @code{#!curly-infix-and-bracket-lists}.  For example:
+
+@example
+[a b]    @result{}  ($bracket-list$ a b)
+[a . b]  @result{}  ($bracket-list$ a . b)
+@end example
+
+
+For more information on reader options, @xref{Scheme Read}.
+
 @c srfi-modules.texi ends here
 
 @c Local Variables:
diff --git a/doc/ref/tour.texi b/doc/ref/tour.texi
index 3e612692d..0924216aa 100644
--- a/doc/ref/tour.texi
+++ b/doc/ref/tour.texi
@@ -1,7 +1,7 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2010, 2011
-@c   Free Software Foundation, Inc.
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2010, 2011,
+@c   2012 Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @raisesections
@@ -149,7 +149,7 @@ that makes the @code{j0} function available to Scheme code.
 SCM
 j0_wrapper (SCM x)
 @{
-  return scm_make_real (j0 (scm_num2dbl (x, "j0")));
+  return scm_from_double (j0 (scm_to_double (x)));
 @}
 
 void
diff --git a/libguile/arrays.c b/libguile/arrays.c
index f0f901239..83d7db2b9 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005,
+ *   2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -814,178 +815,6 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
     return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
 }
 
-/* Read an array.  This function can also read vectors and uniform
-   vectors.  Also, the conflict between '#f' and '#f32' and '#f64' is
-   handled here.
-
-   C is the first character read after the '#'.
-*/
-
-static int
-read_decimal_integer (SCM port, int c, ssize_t *resp)
-{
-  ssize_t sign = 1;
-  ssize_t res = 0;
-  int got_it = 0;
-
-  if (c == '-')
-    {
-      sign = -1;
-      c = scm_getc_unlocked (port);
-    }
-
-  while ('0' <= c && c <= '9')
-    {
-      res = 10*res + c-'0';
-      got_it = 1;
-      c = scm_getc_unlocked (port);
-    }
-
-  if (got_it)
-    *resp = sign * res;
-  return c;
-}
-
-SCM
-scm_i_read_array (SCM port, int c)
-{
-  ssize_t rank;
-  scm_t_wchar tag_buf[8];
-  int tag_len;
-
-  SCM tag, shape = SCM_BOOL_F, elements;
-
-  /* XXX - shortcut for ordinary vectors.  Shouldn't be necessary but
-     the array code can not deal with zero-length dimensions yet, and
-     we want to allow zero-length vectors, of course.
-  */
-  if (c == '(')
-    {
-      scm_ungetc_unlocked (c, port);
-      return scm_vector (scm_read (port));
-    }
-
-  /* Disambiguate between '#f' and uniform floating point vectors.
-   */
-  if (c == 'f')
-    {
-      c = scm_getc_unlocked (port);
-      if (c != '3' && c != '6')
-	{
-	  if (c != EOF)
-	    scm_ungetc_unlocked (c, port);
-	  return SCM_BOOL_F;
-	}
-      rank = 1;
-      tag_buf[0] = 'f';
-      tag_len = 1;
-      goto continue_reading_tag;
-    }
-
-  /* Read rank. 
-   */
-  rank = 1;
-  c = read_decimal_integer (port, c, &rank);
-  if (rank < 0)
-    scm_i_input_error (NULL, port, "array rank must be non-negative",
-		       SCM_EOL);
-
-  /* Read tag. 
-   */
-  tag_len = 0;
- continue_reading_tag:
-  while (c != EOF && c != '(' && c != '@' && c != ':'
-         && tag_len < sizeof tag_buf / sizeof tag_buf[0])
-    {
-      tag_buf[tag_len++] = c;
-      c = scm_getc_unlocked (port);
-    }
-  if (tag_len == 0)
-    tag = SCM_BOOL_T;
-  else
-    {
-      tag = scm_string_to_symbol (scm_from_utf32_stringn (tag_buf, tag_len));
-      if (tag_len == sizeof tag_buf / sizeof tag_buf[0])
-        scm_i_input_error (NULL, port, "invalid array tag, starting with: ~a",
-                           scm_list_1 (tag));
-    }
-    
-  /* Read shape. 
-   */
-  if (c == '@' || c == ':')
-    {
-      shape = SCM_EOL;
-      
-      do
-	{
-	  ssize_t lbnd = 0, len = 0;
-	  SCM s;
-
-	  if (c == '@')
-	    {
-	      c = scm_getc_unlocked (port);
-	      c = read_decimal_integer (port, c, &lbnd);
-	    }
-	  
-	  s = scm_from_ssize_t (lbnd);
-
-	  if (c == ':')
-	    {
-	      c = scm_getc_unlocked (port);
-	      c = read_decimal_integer (port, c, &len);
-	      if (len < 0)
-		scm_i_input_error (NULL, port,
-				   "array length must be non-negative",
-				   SCM_EOL);
-
-	      s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
-	    }
-
-	  shape = scm_cons (s, shape);
-	} while (c == '@' || c == ':');
-
-      shape = scm_reverse_x (shape, SCM_EOL);
-    }
-
-  /* Read nested lists of elements.
-   */
-  if (c != '(')
-    scm_i_input_error (NULL, port,
-		       "missing '(' in vector or array literal",
-		       SCM_EOL);
-  scm_ungetc_unlocked (c, port);
-  elements = scm_read (port);
-
-  if (scm_is_false (shape))
-    shape = scm_from_ssize_t (rank);
-  else if (scm_ilength (shape) != rank)
-    scm_i_input_error 
-      (NULL, port,
-       "the number of shape specifications must match the array rank",
-       SCM_EOL);
-
-  /* Handle special print syntax of rank zero arrays; see
-     scm_i_print_array for a rationale.
-  */
-  if (rank == 0)
-    {
-      if (!scm_is_pair (elements))
-	scm_i_input_error (NULL, port,
-			   "too few elements in array literal, need 1",
-			   SCM_EOL);
-      if (!scm_is_null (SCM_CDR (elements)))
-	scm_i_input_error (NULL, port,
-			   "too many elements in array literal, want 1",
-			   SCM_EOL);
-      elements = SCM_CAR (elements);
-    }
-
-  /* Construct array. 
-   */
-  return scm_list_to_typed_array (tag, shape, elements);
-}
-
-
 static SCM
 array_handle_ref (scm_t_array_handle *h, size_t pos)
 {
diff --git a/libguile/arrays.h b/libguile/arrays.h
index 5ea604d6a..6045ab65d 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -3,7 +3,8 @@
 #ifndef SCM_ARRAY_H
 #define SCM_ARRAY_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009,
+ *   2010, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -73,7 +74,6 @@ typedef struct scm_i_t_array
 
 SCM_INTERNAL SCM scm_i_make_array (int ndim);
 SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state *pstate);
-SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
 
 SCM_INTERNAL void scm_init_arrays (void);
 
diff --git a/libguile/hash.c b/libguile/hash.c
index d47c7e054..740dac11f 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -1,4 +1,5 @@
-/*	Copyright (C) 1995,1996,1997, 2000, 2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 2000, 2001, 2003, 2004, 2006, 2008,
+ *   2009, 2010, 2011, 2012 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -223,6 +224,53 @@ scm_i_utf8_string_hash (const char *str, size_t len)
   return ret;
 }
 
+static unsigned long scm_raw_ihashq (scm_t_bits key);
+static unsigned long scm_raw_ihash (SCM obj, size_t depth);
+
+/* Return the hash of struct OBJ.  Traverse OBJ's fields to compute the
+   result, unless DEPTH is zero.  Assumes that OBJ is a struct.  */
+static unsigned long
+scm_i_struct_hash (SCM obj, size_t depth)
+{
+  SCM layout;
+  scm_t_bits *data;
+  size_t struct_size, field_num;
+  unsigned long hash;
+
+  layout = SCM_STRUCT_LAYOUT (obj);
+  struct_size = scm_i_symbol_length (layout) / 2;
+  data = SCM_STRUCT_DATA (obj);
+
+  hash = scm_raw_ihashq (SCM_UNPACK (SCM_STRUCT_VTABLE (obj)));
+  if (depth > 0)
+    for (field_num = 0; field_num < struct_size; field_num++)
+      {
+        int protection;
+
+        protection = scm_i_symbol_ref (layout, field_num * 2 + 1);
+        if (protection != 'h' && protection != 'o')
+          {
+            int type;
+            type = scm_i_symbol_ref (layout, field_num * 2);
+            switch (type)
+              {
+              case 'p':
+                hash ^= scm_raw_ihash (SCM_PACK (data[field_num]),
+                                       depth / 2);
+                break;
+              case 'u':
+                hash ^= scm_raw_ihashq (data[field_num]);
+                break;
+              default:
+                /* Ignore 's' fields.  */;
+              }
+          }
+      }
+
+  /* FIXME: Tail elements should be taken into account.  */
+
+  return hash;
+}
 
 /* Thomas Wang's integer hasher, from
    http://www.cris.com/~Ttwang/tech/inthash.htm.  */
@@ -298,6 +346,8 @@ scm_raw_ihash (SCM obj, size_t depth)
                 ^ scm_raw_ihash (SCM_CDR (obj), depth / 2));
       else
         return scm_raw_ihashq (scm_tc3_cons);
+    case scm_tcs_struct:
+      return scm_i_struct_hash (obj, depth);
     default:
       return scm_raw_ihashq (SCM_CELL_WORD_0 (obj));
     }
diff --git a/libguile/list.c b/libguile/list.c
index 8297b17c5..627640334 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -267,7 +267,7 @@ SCM_DEFINE (scm_append, "append", 0, 0, 1,
 
 
 SCM_DEFINE (scm_append_x, "append!", 0, 0, 1, 
-            (SCM lists),
+            (SCM args),
 	    "A destructive version of @code{append} (@pxref{Pairs and\n"
 	    "Lists,,,r5rs, The Revised^5 Report on Scheme}).  The cdr field\n"
 	    "of each list's final pair is changed to point to the head of\n"
@@ -276,26 +276,29 @@ SCM_DEFINE (scm_append_x, "append!", 0, 0, 1,
 #define FUNC_NAME s_scm_append_x
 {
   SCM ret, *loc;
-  SCM_VALIDATE_REST_ARGUMENT (lists);
+  int argnum = 1;
+  SCM_VALIDATE_REST_ARGUMENT (args);
 
-  if (scm_is_null (lists))
+  if (scm_is_null (args))
     return SCM_EOL;
 
   loc = &ret;
   for (;;)
     {
-      SCM arg = SCM_CAR (lists);
+      SCM arg = SCM_CAR (args);
       *loc = arg;
 
-      lists = SCM_CDR (lists);
-      if (scm_is_null (lists))
+      args = SCM_CDR (args);
+      if (scm_is_null (args))
         return ret;
 
       if (!SCM_NULL_OR_NIL_P (arg))
         {
-          SCM_VALIDATE_CONS (SCM_ARG1, arg);
+          SCM_VALIDATE_CONS (argnum, arg);
           loc = SCM_CDRLOC (scm_last_pair (arg));
+          SCM_VALIDATE_NULL_OR_NIL (argnum, *loc);
         }
+      argnum++;
     }
 }
 #undef FUNC_NAME
diff --git a/libguile/ports.c b/libguile/ports.c
index 11142ba65..e7187d35d 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -613,6 +613,8 @@ scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
   entry->ilseq_handler = handler;
   entry->iconv_descriptors = NULL;
 
+  entry->alist = SCM_EOL;
+
   if (SCM_PORT_DESCRIPTOR (ret)->free)
     scm_i_set_finalizer (SCM2PTR (ret), finalize_port, NULL);
 
@@ -2370,7 +2372,7 @@ scm_lfwrite_substr (SCM str, size_t start, size_t end, SCM port)
   if (end == (size_t) -1)
     end = scm_i_string_length (str);
 
-  scm_display (scm_c_substring (str, start, end), port);
+  scm_i_display_substring (str, start, end, port);
 
   if (pt->rw_random)
     pt->rw_active = SCM_PORT_WRITE;
diff --git a/libguile/ports.h b/libguile/ports.h
index 92e388e82..c1ba71921 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -132,6 +132,10 @@ typedef struct
   scm_t_port_encoding_mode encoding_mode;
   scm_t_string_failed_conversion_handler ilseq_handler;
   scm_t_iconv_descriptors *iconv_descriptors;
+
+  /* an alist for storing additional information
+     (e.g. used to store per-port read options) */
+  SCM alist;
 } scm_t_port;
 
 
diff --git a/libguile/print.c b/libguile/print.c
index 90bc9adf8..5d5c56d2f 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1229,6 +1229,29 @@ write_character (scm_t_wchar ch, SCM port, int string_escapes_p)
     write_character_escaped (ch, string_escapes_p, port);
 }
 
+/* Display STR to PORT from START inclusive to END exclusive.  */
+void
+scm_i_display_substring (SCM str, size_t start, size_t end, SCM port)
+{
+  int narrow_p;
+  const char *buf;
+  size_t len, printed;
+
+  buf = scm_i_string_data (str);
+  len = end - start;
+  narrow_p = scm_i_is_narrow_string (str);
+  buf += start * (narrow_p ? sizeof (char) : sizeof (scm_t_wchar));
+
+  printed = display_string (buf, narrow_p, end - start, port,
+			    PORT_CONVERSION_HANDLER (port));
+
+  if (SCM_UNLIKELY (printed < len))
+    scm_encoding_error (__func__, errno,
+			"cannot convert to output locale",
+			port, scm_c_string_ref (str, printed + start));
+}
+
+
 /* Print an integer.
  */
 
diff --git a/libguile/print.h b/libguile/print.h
index 4a3c2f5c0..80a9922f2 100644
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -3,7 +3,8 @@
 #ifndef SCM_PRINT_H
 #define SCM_PRINT_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2004, 2006, 2008, 2010, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2003, 2004, 2006, 2008,
+ *   2010, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -78,6 +79,8 @@ SCM_API SCM scm_print_options (SCM setting);
 SCM_API SCM scm_make_print_state (void);
 SCM_API void scm_free_print_state (SCM print_state);
 SCM_INTERNAL SCM scm_i_port_with_print_state (SCM port, SCM print_state);
+SCM_INTERNAL void scm_i_display_substring (SCM str, size_t start, size_t end,
+					   SCM port);
 SCM_API void scm_intprint (scm_t_intmax n, int radix, SCM port);
 SCM_API void scm_uintprint (scm_t_uintmax n, int radix, SCM port);
 SCM_API void scm_ipruk (char *hdr, SCM ptr, SCM port);
diff --git a/libguile/private-options.h b/libguile/private-options.h
index 9d2d43cf5..ed0f314e5 100644
--- a/libguile/private-options.h
+++ b/libguile/private-options.h
@@ -67,7 +67,8 @@ SCM_INTERNAL scm_t_option scm_read_opts[];
 #define SCM_R6RS_ESCAPES_P     scm_read_opts[4].val
 #define SCM_SQUARE_BRACKETS_P  scm_read_opts[5].val
 #define SCM_HUNGRY_EOL_ESCAPES_P scm_read_opts[6].val
+#define SCM_CURLY_INFIX_P      scm_read_opts[7].val
 
-#define SCM_N_READ_OPTIONS 6
+#define SCM_N_READ_OPTIONS 7
 
 #endif  /* PRIVATE_OPTIONS */ 
diff --git a/libguile/read.c b/libguile/read.c
index 5738e2ed8..d977cff82 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -63,24 +63,59 @@ SCM_SYMBOL (scm_keyword_prefix, "prefix");
 SCM_SYMBOL (scm_keyword_postfix, "postfix");
 SCM_SYMBOL (sym_nil, "nil");
 
-scm_t_option scm_read_opts[] = {
-  { SCM_OPTION_BOOLEAN, "copy", 0,
-    "Copy source code expressions." },
-  { SCM_OPTION_BOOLEAN, "positions", 1,
-    "Record positions of source code expressions." },
-  { SCM_OPTION_BOOLEAN, "case-insensitive", 0,
-    "Convert symbols to lower case."},
-  { SCM_OPTION_SCM, "keywords", (scm_t_bits) SCM_BOOL_F_BITS,
-    "Style of keyword recognition: #f, 'prefix or 'postfix."},
-  { SCM_OPTION_BOOLEAN, "r6rs-hex-escapes", 0,
-    "Use R6RS variable-length character and string hex escapes."},
-  { SCM_OPTION_BOOLEAN, "square-brackets", 1,
-    "Treat `[' and `]' as parentheses, for R6RS compatibility."},
-  { SCM_OPTION_BOOLEAN, "hungry-eol-escapes", 0,
-    "In strings, consume leading whitespace after an escaped end-of-line."},
-  { 0, },
+/* SRFI-105 curly infix expression support */
+SCM_SYMBOL (sym_nfx, "$nfx$");
+SCM_SYMBOL (sym_bracket_list, "$bracket-list$");
+SCM_SYMBOL (sym_bracket_apply, "$bracket-apply$");
+
+scm_t_option scm_read_opts[] =
+  {
+    { SCM_OPTION_BOOLEAN, "copy", 0,
+      "Copy source code expressions." },
+    { SCM_OPTION_BOOLEAN, "positions", 1,
+      "Record positions of source code expressions." },
+    { SCM_OPTION_BOOLEAN, "case-insensitive", 0,
+      "Convert symbols to lower case."},
+    { SCM_OPTION_SCM, "keywords", (scm_t_bits) SCM_BOOL_F_BITS,
+      "Style of keyword recognition: #f, 'prefix or 'postfix."},
+    { SCM_OPTION_BOOLEAN, "r6rs-hex-escapes", 0,
+      "Use R6RS variable-length character and string hex escapes."},
+    { SCM_OPTION_BOOLEAN, "square-brackets", 1,
+      "Treat `[' and `]' as parentheses, for R6RS compatibility."},
+    { SCM_OPTION_BOOLEAN, "hungry-eol-escapes", 0,
+      "In strings, consume leading whitespace after an escaped end-of-line."},
+    { SCM_OPTION_BOOLEAN, "curly-infix", 0,
+      "Support SRFI-105 curly infix expressions."},
+    { 0, },
+  };
+ 
+/* Internal read options structure.  This is initialized by 'scm_read'
+   from the global and per-port read options, and a pointer is passed
+   down to all helper functions. */
+
+enum t_keyword_style
+  {
+    KEYWORD_STYLE_HASH_PREFIX,
+    KEYWORD_STYLE_PREFIX,
+    KEYWORD_STYLE_POSTFIX
+  };
+
+struct t_read_opts
+{
+  enum t_keyword_style keyword_style;
+  unsigned int copy_source_p        : 1;
+  unsigned int record_positions_p   : 1;
+  unsigned int case_insensitive_p   : 1;
+  unsigned int r6rs_escapes_p       : 1;
+  unsigned int square_brackets_p    : 1;
+  unsigned int hungry_eol_escapes_p : 1;
+  unsigned int curly_infix_p        : 1;
+  unsigned int neoteric_p           : 1;
 };
 
+typedef struct t_read_opts scm_t_read_opts;
+
+
 /*
   Give meaningful error messages for errors
 
@@ -167,6 +202,9 @@ scm_i_read_hash_procedures_set_x (SCM value)
 /* The maximum size of Scheme character names.  */
 #define READER_CHAR_NAME_MAX_SIZE      50
 
+/* The maximum size of reader directive names.  */
+#define READER_DIRECTIVE_NAME_MAX_SIZE 50
+
 
 /* `isblank' is only in C99.  */
 #define CHAR_IS_BLANK_(_chr)					\
@@ -185,10 +223,13 @@ scm_i_read_hash_procedures_set_x (SCM value)
    structure'').  */
 #define CHAR_IS_R5RS_DELIMITER(c)				\
   (CHAR_IS_BLANK (c)						\
-   || (c == ')') || (c == '(') || (c == ';') || (c == '"')      \
-   || (SCM_SQUARE_BRACKETS_P && ((c == '[') || (c == ']'))))
+   || (c) == ')' || (c) == '(' || (c) == ';' || (c) == '"')
 
-#define CHAR_IS_DELIMITER  CHAR_IS_R5RS_DELIMITER
+#define CHAR_IS_DELIMITER(c)                                    \
+  (CHAR_IS_R5RS_DELIMITER (c)                                   \
+   || (((c) == ']' || (c) == '[') && (opts->square_brackets_p   \
+                                      || opts->curly_infix_p))  \
+   || (((c) == '}' || (c) == '{') && opts->curly_infix_p))
 
 /* Exponent markers, as defined in section 7.1.1 of R5RS, ``Lexical
    Structure''.  */
@@ -199,8 +240,8 @@ scm_i_read_hash_procedures_set_x (SCM value)
 /* Read an SCSH block comment.  */
 static SCM scm_read_scsh_block_comment (scm_t_wchar, SCM);
 static SCM scm_read_r6rs_block_comment (scm_t_wchar, SCM);
-static SCM scm_read_commented_expression (scm_t_wchar, SCM);
-static SCM scm_read_shebang (scm_t_wchar, SCM);
+static SCM scm_read_commented_expression (scm_t_wchar, SCM, scm_t_read_opts *);
+static SCM scm_read_shebang (scm_t_wchar, SCM, scm_t_read_opts *);
 static SCM scm_get_hash_procedure (int);
 
 /* Read from PORT until a delimiter (e.g., a whitespace) is read.  Put the
@@ -208,7 +249,8 @@ static SCM scm_get_hash_procedure (int);
    fewer than BUF_SIZE bytes, non-zero otherwise. READ will be set the number of
    bytes actually read.  */
 static int
-read_token (SCM port, char *buf, size_t buf_size, size_t *read)
+read_token (SCM port, scm_t_read_opts *opts,
+            char *buf, size_t buf_size, size_t *read)
 {
    *read = 0;
 
@@ -238,8 +280,8 @@ read_token (SCM port, char *buf, size_t buf_size, size_t *read)
 /* Like `read_token', but return either BUFFER, or a GC-allocated buffer
    if the token doesn't fit in BUFFER_SIZE bytes.  */
 static char *
-read_complete_token (SCM port, char *buffer, size_t buffer_size,
-		     size_t *read)
+read_complete_token (SCM port, scm_t_read_opts *opts,
+                     char *buffer, size_t buffer_size, size_t *read)
 {
   int overflow = 0;
   size_t bytes_read, overflow_size = 0;
@@ -247,7 +289,7 @@ read_complete_token (SCM port, char *buffer, size_t buffer_size,
 
   do
     {
-      overflow = read_token (port, buffer, buffer_size, &bytes_read);
+      overflow = read_token (port, opts, buffer, buffer_size, &bytes_read);
       if (bytes_read == 0)
         break;
       if (overflow || overflow_size != 0)
@@ -284,7 +326,7 @@ read_complete_token (SCM port, char *buffer, size_t buffer_size,
 /* Skip whitespace from PORT and return the first non-whitespace character
    read.  Raise an error on end-of-file.  */
 static int
-flush_ws (SCM port, const char *eoferr)
+flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr)
 {
   scm_t_wchar c;
   while (1)
@@ -321,10 +363,10 @@ flush_ws (SCM port, const char *eoferr)
 	    eoferr = "read_sharp";
 	    goto goteof;
 	  case '!':
-	    scm_read_shebang (c, port);
+	    scm_read_shebang (c, port, opts);
 	    break;
 	  case ';':
-	    scm_read_commented_expression (c, port);
+	    scm_read_commented_expression (c, port, opts);
 	    break;
 	  case '|':
 	    if (scm_is_false (scm_get_hash_procedure (c)))
@@ -355,44 +397,49 @@ flush_ws (SCM port, const char *eoferr)
 
 /* Token readers.  */
 
-static SCM scm_read_expression (SCM port);
-static SCM scm_read_sharp (int chr, SCM port, long line, int column);
+static SCM scm_read_expression (SCM port, scm_t_read_opts *opts);
+static SCM scm_read_sharp (int chr, SCM port, scm_t_read_opts *opts,
+                           long line, int column);
 
 
 static SCM
-maybe_annotate_source (SCM x, SCM port, long line, int column)
+maybe_annotate_source (SCM x, SCM port, scm_t_read_opts *opts,
+                       long line, int column)
 {
-  if (SCM_RECORD_POSITIONS_P)
+  if (opts->record_positions_p)
     scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port));
   return x;
 }
 
 static SCM
-scm_read_sexp (scm_t_wchar chr, SCM port)
+scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 #define FUNC_NAME "scm_i_lreadparen"
 {
   int c;
   SCM tmp, tl, ans = SCM_EOL;
-  const int terminating_char = ((chr == '[') ? ']' : ')');
+  const int curly_list_p = (chr == '{') && opts->curly_infix_p;
+  const int terminating_char = ((chr == '{') ? '}'
+                                : ((chr == '[') ? ']'
+                                   : ')'));
 
   /* Need to capture line and column numbers here. */
   long line = SCM_LINUM (port);
   int column = SCM_COL (port) - 1;
 
-  c = flush_ws (port, FUNC_NAME);
+  c = flush_ws (port, opts, FUNC_NAME);
   if (terminating_char == c)
     return SCM_EOL;
 
   scm_ungetc_unlocked (c, port);
-  tmp = scm_read_expression (port);
+  tmp = scm_read_expression (port, opts);
 
   /* Note that it is possible for scm_read_expression to return
      scm_sym_dot, but not as part of a dotted pair: as in #{.}#.  So
      check that it's a real dot by checking `c'.  */
   if (c == '.' && scm_is_eq (scm_sym_dot, tmp))
     {
-      ans = scm_read_expression (port);
-      if (terminating_char != (c = flush_ws (port, FUNC_NAME)))
+      ans = scm_read_expression (port, opts);
+      if (terminating_char != (c = flush_ws (port, opts, FUNC_NAME)))
 	scm_i_input_error (FUNC_NAME, port, "missing close paren",
 			   SCM_EOL);
       return ans;
@@ -401,28 +448,29 @@ scm_read_sexp (scm_t_wchar chr, SCM port)
   /* Build the head of the list structure. */
   ans = tl = scm_cons (tmp, SCM_EOL);
 
-  while (terminating_char != (c = flush_ws (port, FUNC_NAME)))
+  while (terminating_char != (c = flush_ws (port, opts, FUNC_NAME)))
     {
       SCM new_tail;
 
-      if (c == ')' || (SCM_SQUARE_BRACKETS_P && c == ']'))
+      if (c == ')' || (c == ']' && opts->square_brackets_p)
+          || ((c == '}' || c == ']') && opts->curly_infix_p))
         scm_i_input_error (FUNC_NAME, port,
                            "in pair: mismatched close paren: ~A",
                            scm_list_1 (SCM_MAKE_CHAR (c)));
 
       scm_ungetc_unlocked (c, port);
-      tmp = scm_read_expression (port);
+      tmp = scm_read_expression (port, opts);
 
       /* See above note about scm_sym_dot.  */
       if (c == '.' && scm_is_eq (scm_sym_dot, tmp))
 	{
-	  SCM_SETCDR (tl, scm_read_expression (port));
+	  SCM_SETCDR (tl, scm_read_expression (port, opts));
 
-	  c = flush_ws (port, FUNC_NAME);
+	  c = flush_ws (port, opts, FUNC_NAME);
 	  if (terminating_char != c)
 	    scm_i_input_error (FUNC_NAME, port,
 			       "in pair: missing close paren", SCM_EOL);
-	  goto exit;
+	  break;
 	}
 
       new_tail = scm_cons (tmp, SCM_EOL);
@@ -430,8 +478,60 @@ scm_read_sexp (scm_t_wchar chr, SCM port)
       tl = new_tail;
     }
 
- exit:
-  return maybe_annotate_source (ans, port, line, column);
+  if (curly_list_p)
+    {
+      /* In addition to finding the length, 'scm_ilength' checks for
+         improper or circular lists, in which case it returns -1. */
+      int len = scm_ilength (ans);
+
+      /* The (len == 0) case is handled above */
+      if (len == 1)
+        /* Return directly to avoid re-annotating the element's source
+           location with the position of the outer brace.  Also, it
+           might not be possible to annotate the element. */
+        return scm_car (ans);  /* {e} => e */
+      else if (len == 2)
+        ;  /* Leave the list unchanged: {e1 e2} => (e1 e2) */
+      else if (len >= 3 && (len & 1))
+        {
+          /* It's a proper list whose length is odd and at least 3.  If
+             the elements at odd indices (the infix operator positions)
+             are all 'equal?', then it's a simple curly-infix list.
+             Otherwise it's a mixed curly-infix list. */
+          SCM op = scm_cadr (ans);
+
+          /* Check to see if the elements at odd indices are 'equal?' */
+          for (tl = scm_cdddr (ans); ; tl = scm_cddr (tl))
+            {
+              if (scm_is_null (tl))
+                {
+                  /* Convert simple curly-infix list to prefix:
+                     {a <op> b <op> ...} => (<op> a b ...) */
+                  tl = ans;
+                  while (scm_is_pair (scm_cdr (tl)))
+                    {
+                      tmp = scm_cddr (tl);
+                      SCM_SETCDR (tl, tmp);
+                      tl = tmp;
+                    }
+                  ans = scm_cons (op, ans);
+                  break;
+                }
+              else if (scm_is_false (scm_equal_p (op, scm_car (tl))))
+                {
+                  /* Mixed curly-infix list: {e ...} => ($nfx$ e ...) */
+                  ans = scm_cons (sym_nfx, ans);
+                  break;
+                }
+            }
+        }
+      else
+        /* Mixed curly-infix (possibly improper) list:
+           {e . tail} => ($nfx$ e . tail) */
+        ans = scm_cons (sym_nfx, ans);
+    }
+
+  return maybe_annotate_source (ans, port, opts, line, column);
 }
 #undef FUNC_NAME
 
@@ -487,7 +587,7 @@ skip_intraline_whitespace (SCM port)
 }                                         
 
 static SCM
-scm_read_string (int chr, SCM port)
+scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
 #define FUNC_NAME "scm_lreadr"
 {
   /* For strings smaller than C_STR, this function creates only one Scheme
@@ -526,7 +626,7 @@ scm_read_string (int chr, SCM port)
             case '\\':
               break;
             case '\n':
-              if (SCM_HUNGRY_EOL_ESCAPES_P)
+              if (opts->hungry_eol_escapes_p)
                 skip_intraline_whitespace (port);
               continue;
             case '0':
@@ -554,19 +654,19 @@ scm_read_string (int chr, SCM port)
               c = '\010';
               break;
             case 'x':
-              if (SCM_R6RS_ESCAPES_P)
+              if (opts->r6rs_escapes_p)
                 SCM_READ_HEX_ESCAPE (10, ';');
               else
                 SCM_READ_HEX_ESCAPE (2, '\0');
               break;
             case 'u':
-              if (!SCM_R6RS_ESCAPES_P)
+              if (!opts->r6rs_escapes_p)
                 {
                   SCM_READ_HEX_ESCAPE (4, '\0');
                   break;
                 }
             case 'U':
-              if (!SCM_R6RS_ESCAPES_P)
+              if (!opts->r6rs_escapes_p)
                 {
                   SCM_READ_HEX_ESCAPE (6, '\0');
                   break;
@@ -593,13 +693,13 @@ scm_read_string (int chr, SCM port)
       str = scm_string_concatenate_reverse (str, SCM_UNDEFINED, SCM_UNDEFINED);
     }
 
-  return maybe_annotate_source (str, port, line, column);
+  return maybe_annotate_source (str, port, opts, line, column);
 }
 #undef FUNC_NAME
 
 
 static SCM
-scm_read_number (scm_t_wchar chr, SCM port)
+scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 {
   SCM result, str = SCM_EOL;
   char local_buffer[READER_BUFFER_SIZE], *buffer;
@@ -611,7 +711,7 @@ scm_read_number (scm_t_wchar chr, SCM port)
   int column = SCM_COL (port) - 1;
 
   scm_ungetc_unlocked (chr, port);
-  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
+  buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
 				&bytes_read);
 
   str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
@@ -620,30 +720,30 @@ scm_read_number (scm_t_wchar chr, SCM port)
   if (scm_is_false (result))
     {
       /* Return a symbol instead of a number */
-      if (SCM_CASE_INSENSITIVE_P)
+      if (opts->case_insensitive_p)
         str = scm_string_downcase_x (str);
       result = scm_string_to_symbol (str);
     }
   else if (SCM_NIMP (result))
-    result = maybe_annotate_source (result, port, line, column);
+    result = maybe_annotate_source (result, port, opts, line, column);
 
   SCM_COL (port) += scm_i_string_length (str);
   return result;
 }
 
 static SCM
-scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
+scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 {
   SCM result;
   int ends_with_colon = 0;
   size_t bytes_read;
-  int postfix = scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_postfix);
+  int postfix = (opts->keyword_style == KEYWORD_STYLE_POSTFIX);
   char local_buffer[READER_BUFFER_SIZE], *buffer;
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
   SCM str;
 
   scm_ungetc_unlocked (chr, port);
-  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
+  buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
 				&bytes_read);
   if (bytes_read > 0)
     ends_with_colon = buffer[bytes_read - 1] == ':';
@@ -653,7 +753,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
       str = scm_from_stringn (buffer, bytes_read - 1,
 			      pt->encoding, pt->ilseq_handler);
 
-      if (SCM_CASE_INSENSITIVE_P)
+      if (opts->case_insensitive_p)
         str = scm_string_downcase_x (str);
       result = scm_symbol_to_keyword (scm_string_to_symbol (str));
     }
@@ -662,7 +762,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
       str = scm_from_stringn (buffer, bytes_read,
 			      pt->encoding, pt->ilseq_handler);
 
-      if (SCM_CASE_INSENSITIVE_P)
+      if (opts->case_insensitive_p)
         str = scm_string_downcase_x (str);
       result = scm_string_to_symbol (str);
     }
@@ -672,7 +772,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
 }
 
 static SCM
-scm_read_number_and_radix (scm_t_wchar chr, SCM port)
+scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 #define FUNC_NAME "scm_lreadr"
 {
   SCM result;
@@ -710,7 +810,7 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port)
       radix = 10;
     }
 
-  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
+  buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
 				&read);
 
   pt = SCM_PTAB_ENTRY (port);
@@ -730,7 +830,7 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port)
 #undef FUNC_NAME
 
 static SCM
-scm_read_quote (int chr, SCM port)
+scm_read_quote (int chr, SCM port, scm_t_read_opts *opts)
 {
   SCM p;
   long line = SCM_LINUM (port);
@@ -767,8 +867,8 @@ scm_read_quote (int chr, SCM port)
       abort ();
     }
 
-  p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
-  return maybe_annotate_source (p, port, line, column);
+  p = scm_cons2 (p, scm_read_expression (port, opts), SCM_EOL);
+  return maybe_annotate_source (p, port, opts, line, column);
 }
 
 SCM_SYMBOL (sym_syntax, "syntax");
@@ -777,7 +877,7 @@ SCM_SYMBOL (sym_unsyntax, "unsyntax");
 SCM_SYMBOL (sym_unsyntax_splicing, "unsyntax-splicing");
 
 static SCM
-scm_read_syntax (int chr, SCM port)
+scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts)
 {
   SCM p;
   long line = SCM_LINUM (port);
@@ -814,14 +914,14 @@ scm_read_syntax (int chr, SCM port)
       abort ();
     }
 
-  p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
-  return maybe_annotate_source (p, port, line, column);
+  p = scm_cons2 (p, scm_read_expression (port, opts), SCM_EOL);
+  return maybe_annotate_source (p, port, opts, line, column);
 }
 
 static SCM
-scm_read_nil (int chr, SCM port)
+scm_read_nil (int chr, SCM port, scm_t_read_opts *opts)
 {
-  SCM id = scm_read_mixed_case_symbol (chr, port);
+  SCM id = scm_read_mixed_case_symbol (chr, port, opts);
 
   if (!scm_is_eq (id, sym_nil))
     scm_i_input_error ("scm_read_nil", port,
@@ -867,7 +967,7 @@ scm_read_boolean (int chr, SCM port)
 }
 
 static SCM
-scm_read_character (scm_t_wchar chr, SCM port)
+scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 #define FUNC_NAME "scm_lreadr"
 {
   char buffer[READER_CHAR_NAME_MAX_SIZE];
@@ -877,7 +977,8 @@ scm_read_character (scm_t_wchar chr, SCM port)
   int overflow;
   scm_t_port *pt;
 
-  overflow = read_token (port, buffer, READER_CHAR_NAME_MAX_SIZE, &bytes_read);
+  overflow = read_token (port, opts, buffer, READER_CHAR_NAME_MAX_SIZE,
+                         &bytes_read);
   if (overflow)
     scm_i_input_error (FUNC_NAME, port, "character name too long", SCM_EOL);
 
@@ -973,7 +1074,7 @@ scm_read_character (scm_t_wchar chr, SCM port)
 #undef FUNC_NAME
 
 static SCM
-scm_read_keyword (int chr, SCM port)
+scm_read_keyword (int chr, SCM port, scm_t_read_opts *opts)
 {
   SCM symbol;
 
@@ -982,7 +1083,7 @@ scm_read_keyword (int chr, SCM port)
      to adapt to the delimiters currently valid of symbols.
 
      XXX: This implementation allows sloppy syntaxes like `#:  key'.  */
-  symbol = scm_read_expression (port);
+  symbol = scm_read_expression (port, opts);
   if (!scm_is_symbol (symbol))
     scm_i_input_error ("scm_read_keyword", port,
 		       "keyword prefix `~a' not followed by a symbol: ~s",
@@ -992,34 +1093,186 @@ scm_read_keyword (int chr, SCM port)
 }
 
 static SCM
-scm_read_vector (int chr, SCM port, long line, int column)
+scm_read_vector (int chr, SCM port, scm_t_read_opts *opts,
+                 long line, int column)
 {
   /* Note: We call `scm_read_sexp ()' rather than READER here in order to
      guarantee that it's going to do what we want.  After all, this is an
      implementation detail of `scm_read_vector ()', not a desirable
      property.  */
-  return maybe_annotate_source (scm_vector (scm_read_sexp (chr, port)),
-                                port, line, column);
+  return maybe_annotate_source (scm_vector (scm_read_sexp (chr, port, opts)),
+                                port, opts, line, column);
+}
+
+/* Helper used by scm_read_array */
+static int
+read_decimal_integer (SCM port, int c, ssize_t *resp)
+{
+  ssize_t sign = 1;
+  ssize_t res = 0;
+  int got_it = 0;
+
+  if (c == '-')
+    {
+      sign = -1;
+      c = scm_getc_unlocked (port);
+    }
+
+  while ('0' <= c && c <= '9')
+    {
+      res = 10*res + c-'0';
+      got_it = 1;
+      c = scm_getc_unlocked (port);
+    }
+
+  if (got_it)
+    *resp = sign * res;
+  return c;
 }
 
+/* Read an array.  This function can also read vectors and uniform
+   vectors.  Also, the conflict between '#f' and '#f32' and '#f64' is
+   handled here.
+
+   C is the first character read after the '#'. */
 static SCM
-scm_read_array (int chr, SCM port, long line, int column)
+scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
 {
-  SCM result = scm_i_read_array (port, chr);
-  if (scm_is_false (result))
-    return result;
+  ssize_t rank;
+  scm_t_wchar tag_buf[8];
+  int tag_len;
+
+  SCM tag, shape = SCM_BOOL_F, elements, array;
+
+  /* XXX - shortcut for ordinary vectors.  Shouldn't be necessary but
+     the array code can not deal with zero-length dimensions yet, and
+     we want to allow zero-length vectors, of course. */
+  if (c == '(')
+    return scm_read_vector (c, port, opts, line, column);
+
+  /* Disambiguate between '#f' and uniform floating point vectors. */
+  if (c == 'f')
+    {
+      c = scm_getc_unlocked (port);
+      if (c != '3' && c != '6')
+	{
+	  if (c != EOF)
+	    scm_ungetc_unlocked (c, port);
+	  return SCM_BOOL_F;
+	}
+      rank = 1;
+      tag_buf[0] = 'f';
+      tag_len = 1;
+      goto continue_reading_tag;
+    }
+
+  /* Read rank. */
+  rank = 1;
+  c = read_decimal_integer (port, c, &rank);
+  if (rank < 0)
+    scm_i_input_error (NULL, port, "array rank must be non-negative",
+		       SCM_EOL);
+
+  /* Read tag. */
+  tag_len = 0;
+ continue_reading_tag:
+  while (c != EOF && c != '(' && c != '@' && c != ':'
+         && tag_len < sizeof tag_buf / sizeof tag_buf[0])
+    {
+      tag_buf[tag_len++] = c;
+      c = scm_getc_unlocked (port);
+    }
+  if (tag_len == 0)
+    tag = SCM_BOOL_T;
   else
-    return maybe_annotate_source (result, port, line, column);
+    {
+      tag = scm_string_to_symbol (scm_from_utf32_stringn (tag_buf, tag_len));
+      if (tag_len == sizeof tag_buf / sizeof tag_buf[0])
+        scm_i_input_error (NULL, port, "invalid array tag, starting with: ~a",
+                           scm_list_1 (tag));
+    }
+
+  /* Read shape. */
+  if (c == '@' || c == ':')
+    {
+      shape = SCM_EOL;
+
+      do
+	{
+	  ssize_t lbnd = 0, len = 0;
+	  SCM s;
+
+	  if (c == '@')
+	    {
+	      c = scm_getc_unlocked (port);
+	      c = read_decimal_integer (port, c, &lbnd);
+	    }
+
+	  s = scm_from_ssize_t (lbnd);
+
+	  if (c == ':')
+	    {
+	      c = scm_getc_unlocked (port);
+	      c = read_decimal_integer (port, c, &len);
+	      if (len < 0)
+		scm_i_input_error (NULL, port,
+				   "array length must be non-negative",
+				   SCM_EOL);
+
+	      s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
+	    }
+
+	  shape = scm_cons (s, shape);
+	} while (c == '@' || c == ':');
+
+      shape = scm_reverse_x (shape, SCM_EOL);
+    }
+
+  /* Read nested lists of elements. */
+  if (c != '(')
+    scm_i_input_error (NULL, port,
+		       "missing '(' in vector or array literal",
+		       SCM_EOL);
+  elements = scm_read_sexp (c, port, opts);
+
+  if (scm_is_false (shape))
+    shape = scm_from_ssize_t (rank);
+  else if (scm_ilength (shape) != rank)
+    scm_i_input_error
+      (NULL, port,
+       "the number of shape specifications must match the array rank",
+       SCM_EOL);
+
+  /* Handle special print syntax of rank zero arrays; see
+     scm_i_print_array for a rationale. */
+  if (rank == 0)
+    {
+      if (!scm_is_pair (elements))
+	scm_i_input_error (NULL, port,
+			   "too few elements in array literal, need 1",
+			   SCM_EOL);
+      if (!scm_is_null (SCM_CDR (elements)))
+	scm_i_input_error (NULL, port,
+			   "too many elements in array literal, want 1",
+			   SCM_EOL);
+      elements = SCM_CAR (elements);
+    }
+
+  /* Construct array, annotate with source location, and return. */
+  array = scm_list_to_typed_array (tag, shape, elements);
+  return maybe_annotate_source (array, port, opts, line, column);
 }
 
 static SCM
-scm_read_srfi4_vector (int chr, SCM port, long line, int column)
+scm_read_srfi4_vector (int chr, SCM port, scm_t_read_opts *opts,
+                       long line, int column)
 {
-  return scm_read_array (chr, port, line, column);
+  return scm_read_array (chr, port, opts, line, column);
 }
 
 static SCM
-scm_read_bytevector (scm_t_wchar chr, SCM port, long line, int column)
+scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
+                     long line, int column)
 {
   chr = scm_getc_unlocked (port);
   if (chr != 'u')
@@ -1034,8 +1287,8 @@ scm_read_bytevector (scm_t_wchar chr, SCM port, long line, int column)
     goto syntax;
 
   return maybe_annotate_source
-    (scm_u8_list_to_bytevector (scm_read_sexp (chr, port)),
-     port, line, column);
+    (scm_u8_list_to_bytevector (scm_read_sexp (chr, port, opts)),
+     port, opts, line, column);
 
  syntax:
   scm_i_input_error ("read_bytevector", port,
@@ -1045,7 +1298,8 @@ scm_read_bytevector (scm_t_wchar chr, SCM port, long line, int column)
 }
 
 static SCM
-scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, long line, int column)
+scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
+                           long line, int column)
 {
   /* Read the `#*10101'-style read syntax for bit vectors in Guile.  This is
      terribly inefficient but who cares?  */
@@ -1063,7 +1317,7 @@ scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, long line, int column)
 
   return maybe_annotate_source
     (scm_bitvector (scm_reverse_x (s_bits, SCM_EOL)),
-     port, line, column);
+     port, opts, line, column);
 }
 
 static SCM
@@ -1090,38 +1344,59 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port)
   return SCM_UNSPECIFIED;
 }
 
+static void set_port_case_insensitive_p (SCM port, scm_t_read_opts *opts,
+                                         int value);
+static void set_port_square_brackets_p (SCM port, scm_t_read_opts *opts,
+                                        int value);
+static void set_port_curly_infix_p (SCM port, scm_t_read_opts *opts,
+                                    int value);
+
 static SCM
-scm_read_shebang (scm_t_wchar chr, SCM port)
+scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 {
-  int c = 0;
-  if ((c = scm_get_byte_or_eof_unlocked (port)) != 'r')
-    {
-      scm_ungetc_unlocked (c, port);
-      return scm_read_scsh_block_comment (chr, port);
-    }
-  if ((c = scm_get_byte_or_eof_unlocked (port)) != '6')
-    {
-      scm_ungetc_unlocked (c, port);
-      scm_ungetc_unlocked ('r', port);
-      return scm_read_scsh_block_comment (chr, port);
-    }
-  if ((c = scm_get_byte_or_eof_unlocked (port)) != 'r')
-    {
-      scm_ungetc_unlocked (c, port);
-      scm_ungetc_unlocked ('6', port);
-      scm_ungetc_unlocked ('r', port);
-      return scm_read_scsh_block_comment (chr, port);
-    }
-  if ((c = scm_get_byte_or_eof_unlocked (port)) != 's')
+  char name[READER_DIRECTIVE_NAME_MAX_SIZE + 1];
+  int c;
+  int i = 0;
+
+  while (i <= READER_DIRECTIVE_NAME_MAX_SIZE)
     {
-      scm_ungetc_unlocked (c, port);
-      scm_ungetc_unlocked ('r', port);
-      scm_ungetc_unlocked ('6', port);
-      scm_ungetc_unlocked ('r', port);
-      return scm_read_scsh_block_comment (chr, port);
+      c = scm_getc_unlocked (port);
+      if (c == EOF)
+	scm_i_input_error ("skip_block_comment", port,
+			   "unterminated `#! ... !#' comment", SCM_EOL);
+      else if (('a' <= c && c <= 'z') || ('0' <= c && c <= '9') || c == '-')
+        name[i++] = c;
+      else if (CHAR_IS_DELIMITER (c))
+        {
+          scm_ungetc_unlocked (c, port);
+          name[i] = '\0';
+          if (0 == strcmp ("r6rs", name))
+            ;  /* Silently ignore */
+          else if (0 == strcmp ("fold-case", name))
+            set_port_case_insensitive_p (port, opts, 1);
+          else if (0 == strcmp ("no-fold-case", name))
+            set_port_case_insensitive_p (port, opts, 0);
+          else if (0 == strcmp ("curly-infix", name))
+            set_port_curly_infix_p (port, opts, 1);
+          else if (0 == strcmp ("curly-infix-and-bracket-lists", name))
+            {
+              set_port_curly_infix_p (port, opts, 1);
+              set_port_square_brackets_p (port, opts, 0);
+            }
+          else
+            break;
+
+          return SCM_UNSPECIFIED;
+        }
+      else
+        {
+          scm_ungetc_unlocked (c, port);
+          break;
+        }
     }
-  
-  return SCM_UNSPECIFIED;
+  while (i > 0)
+    scm_ungetc_unlocked (name[--i], port);
+  return scm_read_scsh_block_comment (chr, port);
 }
 
 static SCM
@@ -1163,16 +1438,17 @@ scm_read_r6rs_block_comment (scm_t_wchar chr, SCM port)
 }
 
 static SCM
-scm_read_commented_expression (scm_t_wchar chr, SCM port)
+scm_read_commented_expression (scm_t_wchar chr, SCM port,
+                               scm_t_read_opts *opts)
 {
   scm_t_wchar c;
   
-  c = flush_ws (port, (char *) NULL);
+  c = flush_ws (port, opts, (char *) NULL);
   if (EOF == c)
     scm_i_input_error ("read_commented_expression", port,
                        "no expression after #; comment", SCM_EOL);
   scm_ungetc_unlocked (c, port);
-  scm_read_expression (port);
+  scm_read_expression (port, opts);
   return SCM_UNSPECIFIED;
 }
 
@@ -1274,7 +1550,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port)
 /* Top-level token readers, i.e., dispatchers.  */
 
 static SCM
-scm_read_sharp_extension (int chr, SCM port)
+scm_read_sharp_extension (int chr, SCM port, scm_t_read_opts *opts)
 {
   SCM proc;
 
@@ -1287,7 +1563,8 @@ scm_read_sharp_extension (int chr, SCM port)
 
       got = scm_call_2 (proc, SCM_MAKE_CHAR (chr), port);
 
-      if (scm_is_pair (got) && !scm_i_has_source_properties (got))
+      if (opts->record_positions_p && SCM_NIMP (got)
+          && !scm_i_has_source_properties (got))
         scm_i_set_source_properties_x (got, line, column, SCM_FILENAME (port));
       
       return got;
@@ -1299,43 +1576,44 @@ scm_read_sharp_extension (int chr, SCM port)
 /* The reader for the sharp `#' character.  It basically dispatches reads
    among the above token readers.   */
 static SCM
-scm_read_sharp (scm_t_wchar chr, SCM port, long line, int column)
+scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
+                long line, int column)
 #define FUNC_NAME "scm_lreadr"
 {
   SCM result;
 
   chr = scm_getc_unlocked (port);
 
-  result = scm_read_sharp_extension (chr, port);
+  result = scm_read_sharp_extension (chr, port, opts);
   if (!scm_is_eq (result, SCM_UNSPECIFIED))
     return result;
 
   switch (chr)
     {
     case '\\':
-      return (scm_read_character (chr, port));
+      return (scm_read_character (chr, port, opts));
     case '(':
-      return (scm_read_vector (chr, port, line, column));
+      return (scm_read_vector (chr, port, opts, line, column));
     case 's':
     case 'u':
     case 'f':
     case 'c':
       /* This one may return either a boolean or an SRFI-4 vector.  */
-      return (scm_read_srfi4_vector (chr, port, line, column));
+      return (scm_read_srfi4_vector (chr, port, opts, line, column));
     case 'v':
-      return (scm_read_bytevector (chr, port, line, column));
+      return (scm_read_bytevector (chr, port, opts, line, column));
     case '*':
-      return (scm_read_guile_bit_vector (chr, port, line, column));
+      return (scm_read_guile_bit_vector (chr, port, opts, line, column));
     case 't':
     case 'T':
     case 'F':
       return (scm_read_boolean (chr, port));
     case ':':
-      return (scm_read_keyword (chr, port));
+      return (scm_read_keyword (chr, port, opts));
     case '0': case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9':
     case '@':
-        return (scm_read_array (chr, port, line, column));
+      return (scm_read_array (chr, port, opts, line, column));
 
     case 'i':
     case 'e':
@@ -1349,21 +1627,21 @@ scm_read_sharp (scm_t_wchar chr, SCM port, long line, int column)
     case 'X':
     case 'I':
     case 'E':
-      return (scm_read_number_and_radix (chr, port));
+      return (scm_read_number_and_radix (chr, port, opts));
     case '{':
       return (scm_read_extended_symbol (chr, port));
     case '!':
-      return (scm_read_shebang (chr, port));
+      return (scm_read_shebang (chr, port, opts));
     case ';':
-      return (scm_read_commented_expression (chr, port));
+      return (scm_read_commented_expression (chr, port, opts));
     case '`':
     case '\'':
     case ',':
-      return (scm_read_syntax (chr, port));
+      return (scm_read_syntax (chr, port, opts));
     case 'n':
-      return (scm_read_nil (chr, port));
+      return (scm_read_nil (chr, port, opts));
     default:
-      result = scm_read_sharp_extension (chr, port);
+      result = scm_read_sharp_extension (chr, port, opts);
       if (scm_is_eq (result, SCM_UNSPECIFIED))
 	{
 	  /* To remain compatible with 1.8 and earlier, the following
@@ -1387,8 +1665,8 @@ scm_read_sharp (scm_t_wchar chr, SCM port, long line, int column)
 #undef FUNC_NAME
 
 static SCM
-scm_read_expression (SCM port)
-#define FUNC_NAME "scm_read_expression"
+read_inner_expression (SCM port, scm_t_read_opts *opts)
+#define FUNC_NAME "read_inner_expression"
 {
   while (1)
     {
@@ -1404,23 +1682,55 @@ scm_read_expression (SCM port)
 	case ';':
 	  (void) scm_read_semicolon_comment (chr, port);
 	  break;
+        case '{':
+          if (opts->curly_infix_p)
+            {
+              if (opts->neoteric_p)
+                return scm_read_sexp (chr, port, opts);
+              else
+                {
+                  SCM expr;
+
+                  /* Enable neoteric expressions within curly braces */
+                  opts->neoteric_p = 1;
+                  expr = scm_read_sexp (chr, port, opts);
+                  opts->neoteric_p = 0;
+                  return expr;
+                }
+            }
+          else
+            return scm_read_mixed_case_symbol (chr, port, opts);
 	case '[':
-          if (!SCM_SQUARE_BRACKETS_P)
-            return (scm_read_mixed_case_symbol (chr, port));
-          /* otherwise fall through */
+          if (opts->square_brackets_p)
+            return scm_read_sexp (chr, port, opts);
+          else if (opts->curly_infix_p)
+            {
+              /* The syntax of neoteric expressions requires that '[' be
+                 a delimiter when curly-infix is enabled, so it cannot
+                 be part of an unescaped symbol.  We might as well do
+                 something useful with it, so we adopt Kawa's convention:
+                 [...] => ($bracket-list$ ...) */
+              long line = SCM_LINUM (port);
+              int column = SCM_COL (port) - 1;
+              return maybe_annotate_source
+                (scm_cons (sym_bracket_list, scm_read_sexp (chr, port, opts)),
+                 port, opts, line, column);
+            }
+          else
+            return scm_read_mixed_case_symbol (chr, port, opts);
 	case '(':
-	  return (scm_read_sexp (chr, port));
+	  return (scm_read_sexp (chr, port, opts));
 	case '"':
-	  return (scm_read_string (chr, port));
+	  return (scm_read_string (chr, port, opts));
 	case '\'':
 	case '`':
 	case ',':
-	  return (scm_read_quote (chr, port));
+	  return (scm_read_quote (chr, port, opts));
 	case '#':
 	  {
             long line  = SCM_LINUM (port);
             int column = SCM_COL (port) - 1;
-	    SCM result = scm_read_sharp (chr, port, line, column);
+	    SCM result = scm_read_sharp (chr, port, opts, line, column);
 	    if (scm_is_eq (result, SCM_UNSPECIFIED))
 	      /* We read a comment or some such.  */
 	      break;
@@ -1430,33 +1740,108 @@ scm_read_expression (SCM port)
 	case ')':
 	  scm_i_input_error (FUNC_NAME, port, "unexpected \")\"", SCM_EOL);
 	  break;
+        case '}':
+          if (opts->curly_infix_p)
+            scm_i_input_error (FUNC_NAME, port, "unexpected \"}\"", SCM_EOL);
+          else
+            return scm_read_mixed_case_symbol (chr, port, opts);
 	case ']':
-          if (SCM_SQUARE_BRACKETS_P)
+          if (opts->square_brackets_p)
             scm_i_input_error (FUNC_NAME, port, "unexpected \"]\"", SCM_EOL);
           /* otherwise fall through */
 	case EOF:
 	  return SCM_EOF_VAL;
 	case ':':
-	  if (scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix))
-	    return scm_symbol_to_keyword (scm_read_expression (port));
+	  if (opts->keyword_style == KEYWORD_STYLE_PREFIX)
+	    return scm_symbol_to_keyword (scm_read_expression (port, opts));
 	  /* Fall through.  */
 
 	default:
 	  {
 	    if (((chr >= '0') && (chr <= '9'))
 		|| (strchr ("+-.", chr)))
-	      return (scm_read_number (chr, port));
+	      return (scm_read_number (chr, port, opts));
 	    else
-	      return (scm_read_mixed_case_symbol (chr, port));
+	      return (scm_read_mixed_case_symbol (chr, port, opts));
 	  }
 	}
     }
 }
 #undef FUNC_NAME
 
+static SCM
+scm_read_expression (SCM port, scm_t_read_opts *opts)
+#define FUNC_NAME "scm_read_expression"
+{
+  if (!opts->neoteric_p)
+    return read_inner_expression (port, opts);
+  else
+    {
+      long line = 0;
+      int column = 0;
+      SCM expr;
+
+      if (opts->record_positions_p)
+        {
+          /* We need to get the position of the first non-whitespace
+             character in order to correctly annotate neoteric
+             expressions.  For example, for the expression 'f(x)', the
+             first call to 'read_inner_expression' reads the 'f' (which
+             cannot be annotated), and then we later read the '(x)' and
+             use it to construct the new list (f x). */
+          int c = flush_ws (port, opts, (char *) NULL);
+          if (c == EOF)
+            return SCM_EOF_VAL;
+          scm_ungetc_unlocked (c, port);
+          line = SCM_LINUM (port);
+          column = SCM_COL (port);
+        }
+
+      expr = read_inner_expression (port, opts);
+
+      /* 'expr' is the first component of the neoteric expression.  Now
+         we loop, and as long as the next character is '(', '[', or '{',
+         (without any intervening whitespace), we use it to construct a
+         new expression.  For example, f{n - 1}(x) => ((f (- n 1)) x). */
+      for (;;)
+        {
+          int chr = scm_getc_unlocked (port);
+
+          if (chr == '(')
+            /* e(...) => (e ...) */
+            expr = scm_cons (expr, scm_read_sexp (chr, port, opts));
+          else if (chr == '[')
+            /* e[...] => ($bracket-apply$ e ...) */
+            expr = scm_cons (sym_bracket_apply,
+                             scm_cons (expr,
+                                       scm_read_sexp (chr, port, opts)));
+          else if (chr == '{')
+            {
+              SCM arg = scm_read_sexp (chr, port, opts);
+
+              if (scm_is_null (arg))
+                expr = scm_list_1 (expr);       /* e{} => (e) */
+              else
+                expr = scm_list_2 (expr, arg);  /* e{...} => (e {...}) */
+            }
+          else
+            {
+              if (chr != EOF)
+                scm_ungetc_unlocked (chr, port);
+              break;
+            }
+          maybe_annotate_source (expr, port, opts, line, column);
+        }
+      return expr;
+    }
+}
+#undef FUNC_NAME
+
 
 /* Actual reader.  */
 
+static void init_read_options (SCM port, scm_t_read_opts *opts);
+
 SCM_DEFINE (scm_read, "read", 0, 1, 0, 
             (SCM port),
 	    "Read an s-expression from the input port @var{port}, or from\n"
@@ -1464,18 +1849,21 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
 	    "Any whitespace before the next token is discarded.")
 #define FUNC_NAME s_scm_read
 {
+  scm_t_read_opts opts;
   int c;
 
   if (SCM_UNBNDP (port))
     port = scm_current_input_port ();
   SCM_VALIDATE_OPINPORT (1, port);
 
-  c = flush_ws (port, (char *) NULL);
+  init_read_options (port, &opts);
+
+  c = flush_ws (port, &opts, (char *) NULL);
   if (EOF == c)
     return SCM_EOF_VAL;
   scm_ungetc_unlocked (c, port);
 
-  return (scm_read_expression (port));
+  return (scm_read_expression (port, &opts));
 }
 #undef FUNC_NAME
 
@@ -1732,6 +2120,143 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+
+/* Per-port read options.
+
+   We store per-port read options in the 'port-read-options' key of the
+   port's alist.  The value stored in the alist is a single integer that
+   contains a two-bit field for each read option.
+
+   If a bit field contains READ_OPTION_INHERIT (3), that indicates that
+   the applicable value should be inherited from the corresponding
+   global read option.  Otherwise, the bit field contains the value of
+   the read option.  For boolean read options that have been set
+   per-port, the possible values are 0 or 1.  If the 'keyword_style'
+   read option has been set per-port, its possible values are those in
+   'enum t_keyword_style'. */
+
+/* Key to read options in per-port alists. */
+SCM_SYMBOL (sym_port_read_options, "port-read-options");
+
+/* Offsets of bit fields for each per-port override */
+#define READ_OPTION_COPY_SOURCE_P          0
+#define READ_OPTION_RECORD_POSITIONS_P     2
+#define READ_OPTION_CASE_INSENSITIVE_P     4
+#define READ_OPTION_KEYWORD_STYLE          6
+#define READ_OPTION_R6RS_ESCAPES_P         8
+#define READ_OPTION_SQUARE_BRACKETS_P     10
+#define READ_OPTION_HUNGRY_EOL_ESCAPES_P  12
+#define READ_OPTION_CURLY_INFIX_P         14
+
+/* The total width in bits of the per-port overrides */
+#define READ_OPTIONS_NUM_BITS             16
+
+#define READ_OPTIONS_INHERIT_ALL  ((1UL << READ_OPTIONS_NUM_BITS) - 1)
+#define READ_OPTIONS_MAX_VALUE    READ_OPTIONS_INHERIT_ALL
+
+#define READ_OPTION_MASK     3
+#define READ_OPTION_INHERIT  3
+
+static void
+set_port_read_option (SCM port, int option, int new_value)
+{
+  SCM scm_read_options;
+  unsigned int read_options;
+
+  new_value &= READ_OPTION_MASK;
+  scm_read_options = scm_assq_ref (SCM_PTAB_ENTRY(port)->alist,
+                                   sym_port_read_options);
+  if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
+    read_options = scm_to_uint (scm_read_options);
+  else
+    read_options = READ_OPTIONS_INHERIT_ALL;
+  read_options &= ~(READ_OPTION_MASK << option);
+  read_options |= new_value << option;
+  scm_read_options = scm_from_uint (read_options);
+  SCM_PTAB_ENTRY(port)->alist = scm_assq_set_x (SCM_PTAB_ENTRY(port)->alist,
+                                                sym_port_read_options,
+                                                scm_read_options);
+}
+
+/* Set OPTS and PORT's case-insensitivity according to VALUE. */
+static void
+set_port_case_insensitive_p (SCM port, scm_t_read_opts *opts, int value)
+{
+  value = !!value;
+  opts->case_insensitive_p = value;
+  set_port_read_option (port, READ_OPTION_CASE_INSENSITIVE_P, value);
+}
+
+/* Set OPTS and PORT's square_brackets_p option according to VALUE. */
+static void
+set_port_square_brackets_p (SCM port, scm_t_read_opts *opts, int value)
+{
+  value = !!value;
+  opts->square_brackets_p = value;
+  set_port_read_option (port, READ_OPTION_SQUARE_BRACKETS_P, value);
+}
+
+/* Set OPTS and PORT's curly_infix_p option according to VALUE. */
+static void
+set_port_curly_infix_p (SCM port, scm_t_read_opts *opts, int value)
+{
+  value = !!value;
+  opts->curly_infix_p = value;
+  set_port_read_option (port, READ_OPTION_CURLY_INFIX_P, value);
+}
+
+/* Initialize OPTS based on PORT's read options and the global read
+   options. */
+static void
+init_read_options (SCM port, scm_t_read_opts *opts)
+{
+  SCM val, scm_read_options;
+  unsigned int read_options, x;
+
+  scm_read_options = scm_assq_ref (SCM_PTAB_ENTRY(port)->alist,
+                                   sym_port_read_options);
+
+  if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
+    read_options = scm_to_uint (scm_read_options);
+  else
+    read_options = READ_OPTIONS_INHERIT_ALL;
+
+  x = READ_OPTION_MASK & (read_options >> READ_OPTION_KEYWORD_STYLE);
+  if (x == READ_OPTION_INHERIT)
+    {
+      val = SCM_PACK (SCM_KEYWORD_STYLE);
+      if (scm_is_eq (val, scm_keyword_prefix))
+        x = KEYWORD_STYLE_PREFIX;
+      else if (scm_is_eq (val, scm_keyword_postfix))
+        x = KEYWORD_STYLE_POSTFIX;
+      else
+        x = KEYWORD_STYLE_HASH_PREFIX;
+    }
+  opts->keyword_style = x;
+
+#define RESOLVE_BOOLEAN_OPTION(NAME, name)                              \
+  do                                                                    \
+    {                                                                   \
+      x = READ_OPTION_MASK & (read_options >> READ_OPTION_ ## NAME);    \
+      if (x == READ_OPTION_INHERIT)                                     \
+        x = !!SCM_ ## NAME;                                             \
+          opts->name = x;                                               \
+    }                                                                   \
+  while (0)
+
+  RESOLVE_BOOLEAN_OPTION (COPY_SOURCE_P,        copy_source_p);
+  RESOLVE_BOOLEAN_OPTION (RECORD_POSITIONS_P,   record_positions_p);
+  RESOLVE_BOOLEAN_OPTION (CASE_INSENSITIVE_P,   case_insensitive_p);
+  RESOLVE_BOOLEAN_OPTION (R6RS_ESCAPES_P,       r6rs_escapes_p);
+  RESOLVE_BOOLEAN_OPTION (SQUARE_BRACKETS_P,    square_brackets_p);
+  RESOLVE_BOOLEAN_OPTION (HUNGRY_EOL_ESCAPES_P, hungry_eol_escapes_p);
+  RESOLVE_BOOLEAN_OPTION (CURLY_INFIX_P,        curly_infix_p);
+
+#undef RESOLVE_BOOLEAN_OPTION
+
+  opts->neoteric_p = 0;
+}
+
 void
 scm_init_read ()
 {
diff --git a/libguile/read.h b/libguile/read.h
index 4bd08fa44..3c47afdd0 100644
--- a/libguile/read.h
+++ b/libguile/read.h
@@ -54,7 +54,6 @@ SCM_API SCM scm_sym_dot;
 
 SCM_API SCM scm_read_options (SCM setting);
 SCM_API SCM scm_read (SCM port);
-SCM_API size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird);
 SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc);
 SCM_INTERNAL char *scm_i_scan_for_encoding (SCM port);
 SCM_API SCM scm_file_encoding (SCM port);
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 28345532e..97c5a1d64 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -2993,11 +2993,22 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 3, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
-	    (SCM str, SCM chr),
+	    (SCM str, SCM char_pred),
 	    "Split the string @var{str} into a list of the substrings delimited\n"
-	    "by appearances of the character @var{chr}.  Note that an empty substring\n"
-	    "between separator characters will result in an empty string in the\n"
-	    "result list.\n"
+            "by appearances of characters that\n"
+            "\n"
+            "@itemize @bullet\n"
+            "@item\n"
+            "equal @var{char_pred}, if it is a character,\n"
+            "\n"
+            "@item\n"
+            "satisfy the predicate @var{char_pred}, if it is a procedure,\n"
+            "\n"
+            "@item\n"
+            "are in the set @var{char_pred}, if it is a character set.\n"
+            "@end itemize\n\n"
+            "Note that an empty substring between separator characters\n"
+            "will result in an empty string in the result list.\n"
 	    "\n"
 	    "@lisp\n"
 	    "(string-split \"root:x:0:0:root:/root:/bin/bash\" #\\:)\n"
@@ -3014,47 +3025,73 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
 	    "@end lisp")
 #define FUNC_NAME s_scm_string_split
 {
-  long idx, last_idx;
-  int narrow;
   SCM res = SCM_EOL;
 
   SCM_VALIDATE_STRING (1, str);
-  SCM_VALIDATE_CHAR (2, chr);
   
-  /* This is explicit wide/narrow logic (instead of using
-     scm_i_string_ref) is a speed optimization.  */
-  idx = scm_i_string_length (str);
-  narrow = scm_i_is_narrow_string (str);
-  if (narrow)
+  if (SCM_CHARP (char_pred))
     {
-      const char *buf = scm_i_string_chars (str);
-      while (idx >= 0)
+      long idx, last_idx;
+      int narrow;
+
+      /* This is explicit wide/narrow logic (instead of using
+         scm_i_string_ref) is a speed optimization.  */
+      idx = scm_i_string_length (str);
+      narrow = scm_i_is_narrow_string (str);
+      if (narrow)
+        {
+          const char *buf = scm_i_string_chars (str);
+          while (idx >= 0)
+            {
+              last_idx = idx;
+              while (idx > 0 && buf[idx-1] != (char) SCM_CHAR(char_pred))
+                idx--;
+              if (idx >= 0)
+                {
+                  res = scm_cons (scm_i_substring (str, idx, last_idx), res);
+                  idx--;
+                }
+            }
+        }
+      else
         {
-          last_idx = idx;
-          while (idx > 0 && buf[idx-1] != (char) SCM_CHAR(chr))
-            idx--;
-          if (idx >= 0)
+          const scm_t_wchar *buf = scm_i_string_wide_chars (str);
+          while (idx >= 0)
             {
-              res = scm_cons (scm_i_substring (str, idx, last_idx), res);
-              idx--;
+              last_idx = idx;
+              while (idx > 0 && buf[idx-1] != SCM_CHAR(char_pred))
+                idx--;
+              if (idx >= 0)
+                {
+                  res = scm_cons (scm_i_substring (str, idx, last_idx), res);
+                  idx--;
+                }
             }
         }
     }
   else
     {
-      const scm_t_wchar *buf = scm_i_string_wide_chars (str);
-      while (idx >= 0)
+      SCM sidx, slast_idx;
+
+      if (!SCM_CHARSETP (char_pred))
+        SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
+                    char_pred, SCM_ARG2, FUNC_NAME);
+
+      /* Supporting predicates and character sets involves handling SCM
+         values so there is less chance to optimize. */
+      slast_idx = scm_string_length (str);
+      for (;;)
         {
-          last_idx = idx;
-          while (idx > 0 && buf[idx-1] != SCM_CHAR(chr))
-            idx--;
-          if (idx >= 0)
-            {
-              res = scm_cons (scm_i_substring (str, idx, last_idx), res);
-              idx--;
-            }
+          sidx = scm_string_index_right (str, char_pred, SCM_INUM0, slast_idx);
+          if (scm_is_false (sidx))
+            break;
+          res = scm_cons (scm_substring (str, scm_oneplus (sidx), slast_idx), res);
+          slast_idx = sidx;
         }
+
+      res = scm_cons (scm_substring (str, SCM_INUM0, slast_idx), res);
     }
+
   scm_remember_upto_here_1 (str);
   return res;
 }
diff --git a/libguile/srfi-13.h b/libguile/srfi-13.h
index f63239a25..325e22272 100644
--- a/libguile/srfi-13.h
+++ b/libguile/srfi-13.h
@@ -110,7 +110,7 @@ SCM_API SCM scm_xsubstring (SCM s, SCM from, SCM to, SCM start, SCM end);
 SCM_API SCM scm_string_xcopy_x (SCM target, SCM tstart, SCM s, SCM sfrom, SCM sto, SCM start, SCM end);
 SCM_API SCM scm_string_replace (SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2);
 SCM_API SCM scm_string_tokenize (SCM s, SCM token_char, SCM start, SCM end);
-SCM_API SCM scm_string_split (SCM s, SCM chr);
+SCM_API SCM scm_string_split (SCM s, SCM char_pred);
 SCM_API SCM scm_string_filter (SCM char_pred, SCM s, SCM start, SCM end);
 SCM_API SCM scm_string_delete (SCM char_pred, SCM s, SCM start, SCM end);
 
diff --git a/libguile/strings.c b/libguile/strings.c
index 7c5550fb3..5130cb362 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1997,7 +1997,10 @@ u32_u8_length_in_bytes (const scm_t_uint32 *str, size_t len)
 
 char *
 scm_to_utf8_stringn (SCM str, size_t *lenp)
+#define FUNC_NAME "scm_to_utf8_stringn"
 {
+  SCM_VALIDATE_STRING (1, str);
+
   if (scm_i_is_narrow_string (str))
     return (char *) latin1_to_u8 ((scm_t_uint8 *) scm_i_string_chars (str),
                                   scm_i_string_length (str),
@@ -2044,6 +2047,7 @@ scm_to_utf8_stringn (SCM str, size_t *lenp)
       }
     }
 }
+#undef FUNC_NAME
 
 scm_t_wchar *
 scm_to_utf32_string (SCM str)
diff --git a/meta/Makefile.am b/meta/Makefile.am
index acf885490..c9d6a3fd7 100644
--- a/meta/Makefile.am
+++ b/meta/Makefile.am
@@ -28,7 +28,7 @@ EXTRA_DIST= \
   guild.in guile-config.in
 
 # What we now call `guild' used to be known as `guile-tools'.
-install-data-hook:
+install-exec-hook:
 	guild="`echo $(ECHO_N) guild				\
 	   | $(SED) -e '$(program_transform_name)'`$(EXEEXT)" ;	\
 	guile_tools="`echo $(ECHO_N) guile-tools		\
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 14dfb605e..1285c8364 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3137,8 +3137,11 @@ module '(ice-9 q) '(make-q q-length))}."
                 (lambda (option)
                   (apply (lambda (name value documentation)
                            (display name)
-                           (if (< (string-length (symbol->string name)) 8)
-                               (display #\tab))
+                           (let ((len (string-length (symbol->string name))))
+                             (when (< len 16)
+                               (display #\tab)
+                               (when (< len 8)
+                                 (display #\tab))))
                            (display #\tab)
                            (display value)
                            (display #\tab)
@@ -3509,7 +3512,9 @@ module '(ice-9 q) '(make-q q-length))}."
 (define-syntax define-public
   (syntax-rules ()
     ((_ (name . args) . body)
-     (define-public name (lambda args . body)))
+     (begin
+       (define name (lambda args . body))
+       (export name)))
     ((_ name val)
      (begin
        (define name val)
@@ -3899,7 +3904,7 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;;
 ;;; Currently, the following feature identifiers are supported:
 ;;;
-;;;   guile r5rs srfi-0 srfi-4 srfi-6 srfi-13 srfi-14 srfi-55 srfi-61
+;;;   guile r5rs srfi-0 srfi-4 srfi-6 srfi-13 srfi-14 srfi-55 srfi-61 srfi-105
 ;;;
 ;;; Remember to update the features list when adding more SRFIs.
 ;;;
@@ -3919,6 +3924,7 @@ module '(ice-9 q) '(make-q q-length))}."
     srfi-39  ;; parameterize
     srfi-55  ;; require-extension
     srfi-61  ;; general cond clause
+    srfi-105 ;; curly infix expressions
     ))
 
 ;; This table maps module public interfaces to the list of features.
diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm
index 62a2c9e4f..d60a6e36a 100644
--- a/module/ice-9/command-line.scm
+++ b/module/ice-9/command-line.scm
@@ -1,6 +1,6 @@
 ;;; Parsing Guile's command-line
 
-;;; Copyright (C) 1994-1998, 2000-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 1994-1998, 2000-2011, 2012 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -325,7 +325,7 @@ If FILE begins with `-' the -s switch is mandatory.
 
            ((string=? arg "--listen")   ; start a repl server
             (parse args
-                (cons '(@@ (system repl server) (spawn-server)) out)))
+                   (cons '((@@ (system repl server) spawn-server)) out)))
            
            ((string-prefix? "--listen=" arg) ; start a repl server
             (parse
@@ -336,14 +336,12 @@ If FILE begins with `-' the -s switch is mandatory.
                  ((string->number where) ; --listen=PORT
                   => (lambda (port)
                        (if (and (integer? port) (exact? port) (>= port 0))
-                           `(@@ (system repl server)
-                                (spawn-server
-                                 (make-tcp-server-socket #:port ,port)))
+                           `((@@ (system repl server) spawn-server)
+                             ((@@ (system repl server) make-tcp-server-socket) #:port ,port))
                            (error "invalid port for --listen"))))
                  ((string-prefix? "/" where) ; --listen=/PATH/TO/SOCKET
-                  `(@@ (system repl server)
-                       (spawn-server
-                        (make-unix-domain-server-socket #:path ,where))))
+                  `((@@ (system repl server) spawn-server)
+                    ((@@ (system repl server) make-unix-domain-server-socket) #:path ,where)))
                  (else
                   (error "unknown argument to --listen"))))
               out)))
diff --git a/module/ice-9/curried-definitions.scm b/module/ice-9/curried-definitions.scm
index d55f1fb6a..8c684a18c 100644
--- a/module/ice-9/curried-definitions.scm
+++ b/module/ice-9/curried-definitions.scm
@@ -16,7 +16,8 @@
 
 (define-module (ice-9 curried-definitions)
   #:replace ((cdefine . define)
-             (cdefine* . define*)))
+             (cdefine* . define*)
+             define-public))
 
 (define-syntax cdefine
   (syntax-rules ()
@@ -39,3 +40,14 @@
        (lambda* rest body body* ...)))
     ((_ . rest)
      (define* . rest))))
+
+(define-syntax define-public
+  (syntax-rules ()
+    ((_ (name . args) . body)
+     (begin
+       (cdefine (name . args) . body)
+       (export name)))
+    ((_ name val)
+     (begin
+       (define name val)
+       (export name)))))
diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm
index d038ace5a..eed8cbb0e 100644
--- a/module/ice-9/format.scm
+++ b/module/ice-9/format.scm
@@ -427,15 +427,15 @@
                      (case modifier
                        ((at)
                         (format:out-str
-                         (with-output-to-string 
-                           (lambda ()
-                             (truncated-print (next-arg)
+                         (call-with-output-string
+                           (lambda (p)
+                             (truncated-print (next-arg) p
                                               #:width width)))))
                        ((colon-at)
                         (format:out-str
-                         (with-output-to-string 
-                           (lambda ()
-                             (truncated-print (next-arg)
+                         (call-with-output-string
+                           (lambda (p)
+                             (truncated-print (next-arg) p
                                               #:width
                                               (max (- width
                                                       output-col)
@@ -779,7 +779,7 @@
     (define (format:obj->str obj slashify)
       (let ((res (if slashify
                      (object->string obj)
-                     (with-output-to-string (lambda () (display obj))))))
+                     (call-with-output-string (lambda (p) (display obj p))))))
         (if (and format:read-proof (string-prefix? "#<" res))
             (object->string res)
             res)))
diff --git a/module/ice-9/regex.scm b/module/ice-9/regex.scm
index f7b94b72a..08ae2c2f5 100644
--- a/module/ice-9/regex.scm
+++ b/module/ice-9/regex.scm
@@ -172,8 +172,9 @@
     (let loop ((start 0)
                (value init)
                (abuts #f))              ; True if start abuts a previous match.
+      (define bol (if (zero? start) 0 regexp/notbol))
       (let ((m (if (> start (string-length string)) #f
-                   (regexp-exec regexp string start flags))))
+                   (regexp-exec regexp string start (logior flags bol)))))
         (cond
          ((not m) value)
          ((and (= (match:start m) (match:end m)) abuts)
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 18126863c..e3f6a9071 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -516,6 +516,27 @@
 (define-primitive-expander f64vector-set! (vec i x)
   (bytevector-ieee-double-native-set! vec (* i 8) x))
 
+;; Appropriate for use with either 'eqv?' or 'equal?'.
+(define maybe-simplify-to-eq
+  (case-lambda
+    ((src a b)
+     ;; Simplify cases where either A or B is constant.
+     (define (maybe-simplify a b)
+       (and (const? a)
+            (let ((v (const-exp a)))
+              (and (or (memq v '(#f #t () #nil))
+                       (symbol? v)
+                       (and (integer? v)
+                            (exact? v)
+                            (<= v most-positive-fixnum)
+                            (>= v most-negative-fixnum)))
+                   (make-primcall src 'eq? (list a b))))))
+     (or (maybe-simplify a b) (maybe-simplify b a)))
+    (else #f)))
+
+(hashq-set! *primitive-expand-table* 'eqv?   maybe-simplify-to-eq)
+(hashq-set! *primitive-expand-table* 'equal? maybe-simplify-to-eq)
+
 (hashq-set! *primitive-expand-table*
             '@dynamic-wind
             (case-lambda
diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index d8f764335..c0a27b1a2 100644
--- a/module/srfi/srfi-19.scm
+++ b/module/srfi/srfi-19.scm
@@ -1113,13 +1113,13 @@
    (cons #\1 (lambda (date pad-with port)
                (display (date->string date "~Y-~m-~d") port)))
    (cons #\2 (lambda (date pad-with port)
-               (display (date->string date "~k:~M:~S~z") port)))
+               (display (date->string date "~H:~M:~S~z") port)))
    (cons #\3 (lambda (date pad-with port)
-               (display (date->string date "~k:~M:~S") port)))
+               (display (date->string date "~H:~M:~S") port)))
    (cons #\4 (lambda (date pad-with port)
-               (display (date->string date "~Y-~m-~dT~k:~M:~S~z") port)))
+               (display (date->string date "~Y-~m-~dT~H:~M:~S~z") port)))
    (cons #\5 (lambda (date pad-with port)
-               (display (date->string date "~Y-~m-~dT~k:~M:~S") port)))))
+               (display (date->string date "~Y-~m-~dT~H:~M:~S") port)))))
 
 
 (define (get-formatter char)
diff --git a/module/srfi/srfi-31.scm b/module/srfi/srfi-31.scm
index 4238dc269..cf67e8af5 100644
--- a/module/srfi/srfi-31.scm
+++ b/module/srfi/srfi-31.scm
@@ -1,6 +1,6 @@
 ;;; srfi-31.scm --- special form for recursive evaluation
 
-;; 	Copyright (C) 2004, 2006 Free Software Foundation, Inc.
+;; 	Copyright (C) 2004, 2006, 2012 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -19,17 +19,15 @@
 ;;; Original author: Rob Browning <rlb@defaultvalue.org>
 
 (define-module (srfi srfi-31)
-  :export-syntax (rec))
+  #:export (rec))
 
-(define-macro (rec arg-form . body)
-  (cond
-   ((and (symbol? arg-form) (= 1 (length body)))
-    ;; (rec S (cons 1 (delay S)))
-    `(letrec ((,arg-form ,(car body)))
-       ,arg-form))
-   ;; (rec (f x) (+ x 1))
-   ((list? arg-form)
-    `(letrec ((,(car arg-form) (lambda ,(cdr arg-form) ,@body)))
-       ,(car arg-form)))
-   (else
-    (error "syntax error in rec form" `(rec ,arg-form ,@body)))))
+(define-syntax rec
+  (syntax-rules ()
+    "Return the given object, defined in a lexical environment where
+NAME is bound to itself."
+    ((_ (name . formals) body ...)                ; procedure
+     (letrec ((name (lambda formals body ...)))
+       name))
+    ((_ name expr)                                ; arbitrary object
+     (letrec ((name expr))
+       name))))
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 0bc11a30f..afcb55a72 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -1,6 +1,6 @@
 ;;; High-level compiler interface
 
-;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -72,7 +72,7 @@
 ;; before the check, so that we avoid races (possibly due to parallel
 ;; compilation).
 ;;
-(define (ensure-writable-dir dir)
+(define (ensure-directory dir)
   (catch 'system-error
     (lambda ()
       (mkdir dir))
@@ -80,13 +80,12 @@
       (let ((errno (and (pair? rest) (car rest))))
         (cond
          ((eqv? errno EEXIST)
-          (let ((st (stat dir)))
-            (if (or (not (eq? (stat:type st) 'directory))
-                    (not (access? dir W_OK)))
-                (error "directory not writable" dir))))
+          ;; Assume it's a writable directory, to avoid TOCTOU errors,
+          ;; as well as UID/EUID mismatches that occur with access(2).
+          #t)
          ((eqv? errno ENOENT)
-          (ensure-writable-dir (dirname dir))
-          (ensure-writable-dir dir))
+          (ensure-directory (dirname dir))
+          (ensure-directory dir))
          (else
           (throw k subr fmt args rest)))))))
 
@@ -125,7 +124,7 @@
                  %compile-fallback-path
                  (canonical->suffix (canonicalize-path file))
                  (compiled-extension))))
-         (and (false-if-exception (ensure-writable-dir (dirname f)))
+         (and (false-if-exception (ensure-directory (dirname f)))
               f))))
 
 (define* (compile-file file #:key
@@ -144,7 +143,7 @@
       ;; Choose the input encoding deterministically.
       (set-port-encoding! in (or enc "UTF-8"))
 
-      (ensure-writable-dir (dirname comp))
+      (ensure-directory (dirname comp))
       (call-with-output-file/atomic comp
         (lambda (port)
           ((language-printer (ensure-language to))
diff --git a/module/texinfo.scm b/module/texinfo.scm
index 2ffd85393..519db485d 100644
--- a/module/texinfo.scm
+++ b/module/texinfo.scm
@@ -384,8 +384,14 @@ Examples:
 
 ;; Like a DTD for texinfo
 (define (command-spec command)
-  (or (assq command texi-command-specs)
-      (parser-error #f "Unknown command" command)))
+  (let ((spec (assq command texi-command-specs)))
+    (cond
+     ((not spec)
+      (parser-error #f "Unknown command" command))
+     ((eq? (cadr spec) 'ALIAS)
+      (command-spec (cddr spec)))
+     (else
+      spec))))
 
 (define (inline-content? content)
   (case content
@@ -647,11 +653,10 @@ Examples:
     (arguments->attlist port (read-arguments port stop-char) arg-names))
 
   (let* ((spec (command-spec command))
+         (command (car spec))
          (type (cadr spec))
          (arg-names (cddr spec)))
     (case type
-      ((ALIAS)
-       (complete-start-command arg-names port))
       ((INLINE-TEXT)
        (assert-curr-char '(#\{) "Inline element lacks {" port)
        (values command '() type))
@@ -954,7 +959,9 @@ Examples:
                          (loop port expect-eof? end-para need-break? seed)))
                       ((START)          ; Start of an @-command
                        (let* ((head (token-head token))
-                              (type (cadr (command-spec head)))
+                              (spec (command-spec head))
+                              (head (car spec))
+                              (type (cadr spec))
                               (inline? (inline-content? type))
                               (seed ((if (and inline? (not need-break?))
                                          identity end-para) seed))
@@ -1045,8 +1052,9 @@ Examples:
    (lambda (command args content seed)      ; fdown
      '())
    (lambda (command args parent-seed seed)  ; fup
-     (let ((seed (reverse-collect-str-drop-ws seed))
-           (spec (command-spec command)))
+     (let* ((seed (reverse-collect-str-drop-ws seed))
+            (spec (command-spec command))
+            (command (car spec)))
        (if (eq? (cadr spec) 'INLINE-TEXT-ARGS)
            (cons (list command (cons '% (parse-inline-text-args #f spec seed)))
                  parent-seed)
@@ -1062,8 +1070,10 @@ Examples:
   (let ((parser (make-dom-parser)))
     ;; duplicate arguments->attlist to avoid unnecessary splitting
     (lambda (command port)
-      (let ((args (cdar (parser '*ENVIRON-ARGS* port '())))
-            (arg-names (cddr (command-spec command))))
+      (let* ((args (cdar (parser '*ENVIRON-ARGS* port '())))
+             (spec (command-spec command))
+             (command (car spec))
+             (arg-names (cddr spec)))
         (cond
          ((not arg-names)
           (if (null? args) '()
diff --git a/module/web/client.scm b/module/web/client.scm
index b0356680d..cf7ea5325 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -1,6 +1,6 @@
 ;;; Web client
 
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -42,19 +42,37 @@
             http-get))
 
 (define (open-socket-for-uri uri)
-  (let* ((ai (car (getaddrinfo (uri-host uri)
-                               (cond
-                                ((uri-port uri) => number->string)
-                                (else (symbol->string (uri-scheme uri)))))))
-         (s  (socket (addrinfo:fam ai) (addrinfo:socktype ai)
-                     (addrinfo:protocol ai))))
-    (set-port-encoding! s "ISO-8859-1")
-    (connect s (addrinfo:addr ai))
-    ;; Buffer input and output on this port.
-    (setvbuf s _IOFBF)
-    ;; Enlarge the receive buffer.
-    (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))
-    s))
+  "Return an open input/output port for a connection to URI."
+  (define addresses
+    (let ((port (uri-port uri)))
+      (getaddrinfo (uri-host uri)
+                   (cond (port => number->string)
+                         (else (symbol->string (uri-scheme uri))))
+                   (if port
+                       AI_NUMERICSERV
+                       0))))
+
+  (let loop ((addresses addresses))
+    (let* ((ai (car addresses))
+           (s  (socket (addrinfo:fam ai) (addrinfo:socktype ai)
+                       (addrinfo:protocol ai))))
+      (set-port-encoding! s "ISO-8859-1")
+
+      (catch 'system-error
+        (lambda ()
+          (connect s (addrinfo:addr ai))
+
+          ;; Buffer input and output on this port.
+          (setvbuf s _IOFBF)
+          ;; Enlarge the receive buffer.
+          (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))
+          s)
+        (lambda args
+          ;; Connection failed, so try one of the other addresses.
+          (close s)
+          (if (null? addresses)
+              (apply throw args)
+              (loop (cdr addresses))))))))
 
 (define (decode-string bv encoding)
   (if (string-ci=? encoding "utf-8")
diff --git a/module/web/uri.scm b/module/web/uri.scm
index 109118b12..78614a520 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -364,7 +364,9 @@ Percent-encoding first writes out the given character to a bytevector
 within the given @var{encoding}, then encodes each byte as
 @code{%@var{HH}}, where @var{HH} is the hexadecimal representation of
 the byte."
-  (if (string-index str unescaped-chars)
+  (define (needs-escaped? ch)
+    (not (char-set-contains? unescaped-chars ch)))
+  (if (string-index str needs-escaped?)
       (call-with-output-string*
        (lambda (port)
          (string-for-each
@@ -377,6 +379,8 @@ the byte."
                     (if (< i len)
                         (let ((byte (bytevector-u8-ref bv i)))
                           (display #\% port)
+                          (when (< byte 16)
+                            (display #\0 port))
                           (display (number->string byte 16) port)
                           (lp (1+ i))))))))
           str)))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index c20a97752..24132595e 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -136,6 +136,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/srfi-67.test			\
 	    tests/srfi-69.test			\
 	    tests/srfi-88.test			\
+	    tests/srfi-105.test			\
 	    tests/srfi-4.test			\
 	    tests/srfi-9.test			\
 	    tests/statprof.test			\
diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test
index bdc9bdb41..98854f73a 100644
--- a/test-suite/tests/chars.test
+++ b/test-suite/tests/chars.test
@@ -45,18 +45,18 @@
     (pass-if "char=? #\\A #\\A"
       (char=? #\A #\A))
 
-    (expect-fail "char=? #\\A #\\a"
-      (char=? #\A #\a))
+    (pass-if "char=? #\\A #\\a"
+      (not (char=? #\A #\a)))
 
-    (expect-fail "char=? #\\A #\\B"
-      (char=? #\A #\B))
+    (pass-if "char=? #\\A #\\B"
+      (not (char=? #\A #\B)))
 
-    (expect-fail "char=? #\\B #\\A"
-      (char=? #\A #\B))
+    (pass-if "char=? #\\B #\\A"
+      (not (char=? #\A #\B)))
 
     ;; char<?
-    (expect-fail "char<? #\\A #\\A"
-      (char<? #\A #\A))
+    (pass-if "char<? #\\A #\\A"
+      (not (char<? #\A #\A)))
 
     (pass-if "char<? #\\A #\\a"
       (char<? #\A #\a))
@@ -64,8 +64,8 @@
     (pass-if "char<? #\\A #\\B"
       (char<? #\A #\B))
 
-    (expect-fail "char<? #\\B #\\A"
-      (char<? #\B #\A))
+    (pass-if "char<? #\\B #\\A"
+      (not (char<? #\B #\A)))
 
     ;; char<=?
     (pass-if "char<=? #\\A #\\A"
@@ -77,18 +77,18 @@
     (pass-if "char<=? #\\A #\\B"
       (char<=? #\A #\B))
 
-    (expect-fail "char<=? #\\B #\\A"
-      (char<=? #\B #\A))
+    (pass-if "char<=? #\\B #\\A"
+      (not (char<=? #\B #\A)))
 
     ;; char>?
-    (expect-fail "char>? #\\A #\\A"
-      (char>? #\A #\A))
+    (pass-if "char>? #\\A #\\A"
+      (not (char>? #\A #\A)))
 
-    (expect-fail "char>? #\\A #\\a"
-      (char>? #\A #\a))
+    (pass-if "char>? #\\A #\\a"
+      (not (char>? #\A #\a)))
 
-    (expect-fail "char>? #\\A #\\B"
-      (char>? #\A #\B))
+    (pass-if "char>? #\\A #\\B"
+      (not (char>? #\A #\B)))
 
     (pass-if "char>? #\\B #\\A"
       (char>? #\B #\A))
@@ -97,11 +97,11 @@
     (pass-if "char>=? #\\A #\\A"
       (char>=? #\A #\A))
 
-    (expect-fail "char>=? #\\A #\\a"
-      (char>=? #\A #\a))
+    (pass-if "char>=? #\\A #\\a"
+      (not (char>=? #\A #\a)))
 
-    (expect-fail "char>=? #\\A #\\B"
-      (char>=? #\A #\B))
+    (pass-if "char>=? #\\A #\\B"
+      (not (char>=? #\A #\B)))
 
     (pass-if "char>=? #\\B #\\A"
       (char>=? #\B #\A))
@@ -113,24 +113,24 @@
     (pass-if "char-ci=? #\\A #\\a"
       (char-ci=? #\A #\a))
 
-    (expect-fail "char-ci=? #\\A #\\B"
-      (char-ci=? #\A #\B))
+    (pass-if "char-ci=? #\\A #\\B"
+      (not (char-ci=? #\A #\B)))
 
-    (expect-fail "char-ci=? #\\B #\\A"
-      (char-ci=? #\A #\B))
+    (pass-if "char-ci=? #\\B #\\A"
+      (not (char-ci=? #\A #\B)))
 
     ;; char-ci<?
-    (expect-fail "char-ci<? #\\A #\\A"
-      (char-ci<? #\A #\A))
+    (pass-if "char-ci<? #\\A #\\A"
+      (not (char-ci<? #\A #\A)))
 
-    (expect-fail "char-ci<? #\\A #\\a"
-      (char-ci<? #\A #\a))
+    (pass-if "char-ci<? #\\A #\\a"
+      (not (char-ci<? #\A #\a)))
 
     (pass-if "char-ci<? #\\A #\\B"
       (char-ci<? #\A #\B))
 
-    (expect-fail "char-ci<? #\\B #\\A"
-      (char-ci<? #\B #\A))
+    (pass-if "char-ci<? #\\B #\\A"
+      (not (char-ci<? #\B #\A)))
 
     ;; char-ci<=?
     (pass-if "char-ci<=? #\\A #\\A"
@@ -142,18 +142,18 @@
     (pass-if "char-ci<=? #\\A #\\B"
       (char-ci<=? #\A #\B))
 
-    (expect-fail "char-ci<=? #\\B #\\A"
-      (char-ci<=? #\B #\A))
+    (pass-if "char-ci<=? #\\B #\\A"
+      (not (char-ci<=? #\B #\A)))
 
     ;; char-ci>?
-    (expect-fail "char-ci>? #\\A #\\A"
-      (char-ci>? #\A #\A))
+    (pass-if "char-ci>? #\\A #\\A"
+      (not (char-ci>? #\A #\A)))
 
-    (expect-fail "char-ci>? #\\A #\\a"
-      (char-ci>? #\A #\a))
+    (pass-if "char-ci>? #\\A #\\a"
+      (not (char-ci>? #\A #\a)))
 
-    (expect-fail "char-ci>? #\\A #\\B"
-      (char-ci>? #\A #\B))
+    (pass-if "char-ci>? #\\A #\\B"
+      (not (char-ci>? #\A #\B)))
 
     (pass-if "char-ci>? #\\B #\\A"
       (char-ci>? #\B #\A))
@@ -165,8 +165,8 @@
     (pass-if "char-ci>=? #\\A #\\a"
       (char-ci>=? #\A #\a))
 
-    (expect-fail "char-ci>=? #\\A #\\B"
-      (char-ci>=? #\A #\B))
+    (pass-if "char-ci>=? #\\A #\\B"
+      (not (char-ci>=? #\A #\B)))
 
     (pass-if "char-ci>=? #\\B #\\A"
       (char-ci>=? #\B #\A)))
diff --git a/test-suite/tests/list.test b/test-suite/tests/list.test
index dc06f0795..ff31c8605 100644
--- a/test-suite/tests/list.test
+++ b/test-suite/tests/list.test
@@ -439,15 +439,15 @@
 
   (with-test-prefix "wrong argument"
 
-    (expect-fail-exception "improper list and empty list"
+    (pass-if-exception "improper list and empty list"
       exception:wrong-type-arg
       (append! (cons 1 2) '()))
 
-    (expect-fail-exception "improper list and list"
+    (pass-if-exception "improper list and list"
       exception:wrong-type-arg
       (append! (cons 1 2) (list 3 4)))
 
-    (expect-fail-exception "list, improper list and list"
+    (pass-if-exception "list, improper list and list"
       exception:wrong-type-arg
       (append! (list 1 2) (cons 3 4) (list 5 6)))
 
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index a6697c9a3..ddbd2097e 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -4845,7 +4845,7 @@
                     (test+/- n d))))))
 
     (with-test-prefix "divide by zero"
-      (for `((0 0.0 +0.0))  ;; denominators
+      (for `((0 0.0 -0.0))  ;; denominators
            (lambda (d)
              (for `((15 ,(* 3/2 big) 18.0 33/7
                         0 0.0 -0.0 +inf.0 -inf.0 +nan.0))  ;; numerators
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 60c853cf4..6e02255ad 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -401,6 +401,19 @@
         (lambda ()
           (read-disable 'hungry-eol-escapes))))))
 
+(with-test-prefix "per-port-read-options"
+  (pass-if "case-sensitive"
+    (equal? '(guile GuiLe gUIle)
+            (with-read-options '(case-insensitive)
+              (lambda ()
+                (with-input-from-string "GUIle #!no-fold-case GuiLe gUIle"
+                  (lambda ()
+                    (list (read) (read) (read))))))))
+  (pass-if "case-insensitive"
+    (equal? '(GUIle guile guile)
+            (with-input-from-string "GUIle #!fold-case GuiLe gUIle"
+              (lambda ()
+                (list (read) (read) (read)))))))
 
 (with-test-prefix "#;"
   (for-each
diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index c2b65a64c..eba415314 100644
--- a/test-suite/tests/regexp.test
+++ b/test-suite/tests/regexp.test
@@ -1,8 +1,9 @@
 ;;;; regexp.test ---  test Guile's regexps   -*- coding: utf-8; mode: scheme -*-
 ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
 ;;;;
-;;;; 	Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-;;;; 
+;;;; 	Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009, 2010,
+;;;;      2012 Free Software Foundation, Inc.
+;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
@@ -131,7 +132,14 @@
                    (lambda (match result)
                      (cons (match:substring match)
                            result))
-                   (logior regexp/notbol regexp/noteol)))))
+                   (logior regexp/notbol regexp/noteol))))
+
+  (pass-if "regexp/notbol is set correctly"
+    (equal? '("foo")
+            (fold-matches "^foo" "foofoofoofoo" '()
+                          (lambda (match result)
+                            (cons (match:substring match)
+                                  result))))))
 
 
 ;;;
@@ -282,4 +290,12 @@
     (with-locale "en_US.utf8"
       ;; bug #31650
       (equal? (match:substring (string-match ".*" "calçot") 0)
-              "calçot"))))
+              "calçot")))
+
+  (pass-if "match structures refer to char offsets, non-ASCII pattern"
+    (with-locale "en_US.utf8"
+      ;; bug #31650
+      (equal? (match:substring (string-match "λ: The Ultimate (.*)"
+                                             "λ: The Ultimate GOTO")
+                               1)
+              "GOTO"))))
diff --git a/test-suite/tests/srfi-105.test b/test-suite/tests/srfi-105.test
new file mode 100644
index 000000000..99a084bb3
--- /dev/null
+++ b/test-suite/tests/srfi-105.test
@@ -0,0 +1,240 @@
+;;;; srfi-105.test --- Test suite for Guile's SRFI-105 reader. -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2012 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-srfi-105)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-1))
+
+(define (read-string s)
+  (with-fluids ((%default-port-encoding #f))
+    (with-input-from-string s read)))
+
+(define (with-read-options opts thunk)
+  (let ((saved-options (read-options)))
+    (dynamic-wind
+        (lambda ()
+          (read-options opts))
+        thunk
+        (lambda ()
+          (read-options saved-options)))))
+
+;; Verify that curly braces are allowed in identifiers and that neoteric
+;; expressions are not recognized by default.
+(with-test-prefix "no-curly-infix"
+  (pass-if (equal? '({f(x) + g[y] + h{z} + [a]})
+                   `(,(string->symbol "{f")
+                     (x) + g [y] +
+                     ,(string->symbol "h{z}")
+                     + [a]
+                     ,(string->symbol "}")))))
+
+#!curly-infix
+
+(with-test-prefix "curly-infix"
+  (pass-if (equal? '{n <= 5}                '(<= n 5)))
+  (pass-if (equal? '{x + 1}                 '(+ x 1)))
+  (pass-if (equal? '{a + b + c}             '(+ a b c)))
+  (pass-if (equal? '{x ,op y ,op z}         '(,op x y z)))
+  (pass-if (equal? '{x eqv? `a}             '(eqv? x `a)))
+  (pass-if (equal? '{'a eq? b}              '(eq? 'a b)))
+  (pass-if (equal? '{n-1 + n-2}             '(+ n-1 n-2)))
+  (pass-if (equal? '{a * {b + c}}           '(* a (+ b c))))
+  (pass-if (equal? '{a + {b - c}}           '(+ a (- b c))))
+  (pass-if (equal? '{{a + b} - c}           '(- (+ a b) c)))
+  (pass-if (equal? '{{a > 0} and {b >= 1}}  '(and (> a 0) (>= b 1))))
+  (pass-if (equal? '{}                      '()))
+  (pass-if (equal? '{5}                     '5))
+  (pass-if (equal? '{- x}                   '(- x)))
+  (pass-if (equal? '{length(x) >= 6}        '(>= (length x) 6)))
+  (pass-if (equal? '{f(x) + g(y) + h(z)}    '(+ (f x) (g y) (h z))))
+  (pass-if (equal? '{(f a b) + (g h)}       '(+ (f a b) (g h))))
+  (pass-if (equal? '{f(a b) + g(h)}         '(+ (f a b) (g h))))
+  (pass-if (equal? ''{a + f(b) + x}         ''(+ a (f b) x)))
+  (pass-if (equal? '{(- a) / b}             '(/ (- a) b)))
+  (pass-if (equal? '{-(a) / b}              '(/ (- a) b)))
+  (pass-if (equal? '{cos(q)}                '(cos q)))
+  (pass-if (equal? '{e{}}                   '(e)))
+  (pass-if (equal? '{pi{}}                  '(pi)))
+  (pass-if (equal? '{'f(x)}                 '(quote (f x))))
+
+  (pass-if (equal? '{ (f (g h(x))) }        '(f (g (h x)))))
+  (pass-if (equal? '{#(1 2 f(a) 4)}         '#(1 2 (f a) 4)))
+  (pass-if (equal? '{ (f #;g(x) h(x)) }     '(f (h x))))
+  (pass-if (equal? '{ (f #; g(x)[y] h(x)) } '(f (h x))))
+  (pass-if (equal? '{ (f #; g[x]{y} h(x)) } '(f (h x))))
+
+  (pass-if (equal? '{ (f #(g h(x))) }       '(f #(g (h x)))))
+  (pass-if (equal? '{ (f '(g h(x))) }       '(f '(g (h x)))))
+  (pass-if (equal? '{ (f `(g h(x))) }       '(f `(g (h x)))))
+  (pass-if (equal? '{ (f #'(g h(x))) }      '(f #'(g (h x)))))
+  (pass-if (equal? '{ (f #2((g) (h(x)))) }  '(f #2((g) ((h x))))))
+
+  (pass-if (equal? '{(map - ns)}            '(map - ns)))
+  (pass-if (equal? '{map(- ns)}             '(map - ns)))
+  (pass-if (equal? '{n * factorial{n - 1}}  '(* n (factorial (- n 1)))))
+  (pass-if (equal? '{2 * sin{- x}}          '(* 2 (sin (- x)))))
+
+  (pass-if (equal? '{3 + 4 +}               '($nfx$ 3 + 4 +)))
+  (pass-if (equal? '{3 + 4 + 5 +}           '($nfx$ 3 + 4 + 5 +)))
+  (pass-if (equal? '{a . z}                 '($nfx$ a . z)))
+  (pass-if (equal? '{a + b - c}             '($nfx$ a + b - c)))
+
+  (pass-if (equal? '{read(. options)}       '(read . options)))
+
+  (pass-if (equal? '{a(x)(y)}               '((a x) y)))
+  (pass-if (equal? '{x[a]}                  '($bracket-apply$ x a)))
+  (pass-if (equal? '{y[a b]}                '($bracket-apply$ y a b)))
+
+  (pass-if (equal? '{f(g(x))}               '(f (g x))))
+  (pass-if (equal? '{f(g(x) h(x))}          '(f (g x) (h x))))
+
+
+  (pass-if (equal? '{}                      '()))
+  (pass-if (equal? '{e}                     'e))
+  (pass-if (equal? '{e1 e2}                 '(e1 e2)))
+
+  (pass-if (equal? '{a . t}                 '($nfx$ a . t)))
+  (pass-if (equal? '{a b . t}               '($nfx$ a b . t)))
+  (pass-if (equal? '{a b c . t}             '($nfx$ a b c . t)))
+  (pass-if (equal? '{a b c d . t}           '($nfx$ a b c d . t)))
+  (pass-if (equal? '{a + b +}               '($nfx$ a + b +)))
+  (pass-if (equal? '{a + b + c +}           '($nfx$ a + b + c +)))
+  (pass-if (equal? '{q + r * s}             '($nfx$ q + r * s)))
+
+  ;; The following two tests will become relevant when Guile's reader
+  ;; supports datum labels, specified in SRFI-38 (External
+  ;; Representation for Data With Shared Structure).
+
+  ;;(pass-if (equal? '{#1=f(#1#)}             '#1=(f #1#)))
+  ;;(pass-if (equal? '#1={a + . #1#}          '($nfx$ . #1=(a + . #1#))))
+
+  (pass-if (equal? '{e()}                   '(e)))
+  (pass-if (equal? '{e{}}                   '(e)))
+  (pass-if (equal? '{e(1)}                  '(e 1)))
+  (pass-if (equal? '{e{1}}                  '(e 1)))
+  (pass-if (equal? '{e(1 2)}                '(e 1 2)))
+  (pass-if (equal? '{e{1 2}}                '(e (1 2))))
+  (pass-if (equal? '{f{n - 1}}              '(f (- n 1))))
+  (pass-if (equal? '{f{n - 1}(x)}           '((f (- n 1)) x)))
+  (pass-if (equal? '{f{n - 1}{y - 1}}       '((f (- n 1)) (- y 1))))
+  (pass-if (equal? '{f{- x}[y]}             '($bracket-apply$ (f (- x)) y)))
+  (pass-if (equal? '{g{- x}}                '(g (- x))))
+  (pass-if (equal? '{( . e)}                'e))
+
+  (pass-if (equal? '{e[]}                   '($bracket-apply$ e)))
+  (pass-if (equal? '{e[1 2]}                '($bracket-apply$ e 1 2)))
+  (pass-if (equal? '{e[1 . 2]}              '($bracket-apply$ e 1 . 2)))
+
+  ;; Verify that source position information is not recorded if not
+  ;; asked for.
+  (with-test-prefix "no positions"
+    (pass-if "simple curly-infix list"
+      (let ((sexp (with-read-options '(curly-infix)
+                    (lambda ()
+                      (read-string " {1 + 2 + 3}")))))
+        (and (not (source-property sexp 'line))
+             (not (source-property sexp 'column)))))
+    (pass-if "mixed curly-infix list"
+      (let ((sexp (with-read-options '(curly-infix)
+                    (lambda ()
+                      (read-string " {1 + 2 * 3}")))))
+        (and (not (source-property sexp 'line))
+             (not (source-property sexp 'column)))))
+    (pass-if "singleton curly-infix list"
+      (let ((sexp (with-read-options '(curly-infix)
+                    (lambda ()
+                      (read-string " { 1.0 }")))))
+        (and (not (source-property sexp 'line))
+             (not (source-property sexp 'column)))))
+    (pass-if "neoteric expression"
+      (let ((sexp (with-read-options '(curly-infix)
+                    (lambda ()
+                      (read-string " { f(x) }")))))
+        (and (not (source-property sexp 'line))
+             (not (source-property sexp 'column))))))
+
+  ;; Verify that source position information is properly recorded.
+  (with-test-prefix "positions"
+    (pass-if "simple curly-infix list"
+      (let ((sexp (with-read-options '(curly-infix positions)
+                    (lambda ()
+                      (read-string " {1 + 2 + 3}")))))
+        (and (equal? (source-property sexp 'line) 0)
+             (equal? (source-property sexp 'column) 1))))
+    (pass-if "mixed curly-infix list"
+      (let ((sexp (with-read-options '(curly-infix positions)
+                    (lambda ()
+                      (read-string " {1 + 2 * 3}")))))
+        (and (equal? (source-property sexp 'line) 0)
+             (equal? (source-property sexp 'column) 1))))
+    (pass-if "singleton curly-infix list"
+      (let ((sexp (with-read-options '(curly-infix positions)
+                    (lambda ()
+                      (read-string " { 1.0 }")))))
+        (and (equal? (source-property sexp 'line) 0)
+             (equal? (source-property sexp 'column) 3))))
+    (pass-if "neoteric expression"
+      (let ((sexp (with-read-options '(curly-infix positions)
+                    (lambda ()
+                      (read-string " { f(x) }")))))
+        (and (equal? (source-property sexp 'line) 0)
+             (equal? (source-property sexp 'column) 3)))))
+
+  ;; Verify that neoteric expressions are recognized only within curly braces.
+  (pass-if (equal? '(a(x)(y))               '(a (x) (y))))
+  (pass-if (equal? '(x[a])                  '(x [a])))
+  (pass-if (equal? '(y[a b])                '(y [a b])))
+  (pass-if (equal? '(a f{n - 1})            '(a f (- n 1))))
+  (pass-if (equal? '(a f{n - 1}(x))         '(a f (- n 1) (x))))
+  (pass-if (equal? '(a f{n - 1}[x])         '(a f (- n 1) [x])))
+  (pass-if (equal? '(a f{n - 1}{y - 1})     '(a f (- n 1) (- y 1))))
+
+  ;; Verify that bracket lists are not recognized by default.
+  (pass-if (equal? '{[]}                    '()))
+  (pass-if (equal? '{[a]}                   '(a)))
+  (pass-if (equal? '{[a b]}                 '(a b)))
+  (pass-if (equal? '{[a . b]}               '(a . b)))
+  (pass-if (equal? '[]                      '()))
+  (pass-if (equal? '[a]                     '(a)))
+  (pass-if (equal? '[a b]                   '(a b)))
+  (pass-if (equal? '[a . b]                 '(a . b))))
+
+
+#!curly-infix-and-bracket-lists
+
+(with-test-prefix "curly-infix-and-bracket-lists"
+  ;; Verify that these neoteric expressions still work properly
+  ;; when the 'square-brackets' read option is unset (which is done by
+  ;; the '#!curly-infix-and-bracket-lists' reader directive above).
+  (pass-if (equal? '{e[]}                   '($bracket-apply$ e)))
+  (pass-if (equal? '{e[1 2]}                '($bracket-apply$ e 1 2)))
+  (pass-if (equal? '{e[1 . 2]}              '($bracket-apply$ e 1 . 2)))
+
+  ;; The following expressions are not actually part of SRFI-105, but
+  ;; they are handled when the 'curly-infix' read option is set and the
+  ;; 'square-brackets' read option is unset.  This is a non-standard
+  ;; extension of SRFI-105, and follows the convention of GNU Kawa.
+  (pass-if (equal? '{[]}                    '($bracket-list$)))
+  (pass-if (equal? '{[a]}                   '($bracket-list$ a)))
+  (pass-if (equal? '{[a b]}                 '($bracket-list$ a b)))
+  (pass-if (equal? '{[a . b]}               '($bracket-list$ a . b)))
+
+  (pass-if (equal? '[]                      '($bracket-list$)))
+  (pass-if (equal? '[a]                     '($bracket-list$ a)))
+  (pass-if (equal? '[a b]                   '($bracket-list$ a b)))
+  (pass-if (equal? '[a . b]                 '($bracket-list$ a . b))))
diff --git a/test-suite/tests/srfi-31.test b/test-suite/tests/srfi-31.test
index 8537d49b6..62645d918 100644
--- a/test-suite/tests/srfi-31.test
+++ b/test-suite/tests/srfi-31.test
@@ -1,6 +1,6 @@
 ;;;; srfi-31.test --- Test suite for Guile's SRFI-31 functions. -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2004, 2006, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2006, 2010, 2012 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -22,9 +22,10 @@
 
 (with-test-prefix "rec special form"
 
-  (pass-if-exception "bogus variable" '(misc-error . ".*")
+  (pass-if-exception "bogus variable"
+    exception:syntax-pattern-unmatched
     (eval '(rec #:foo) (current-module)))
-  
+
   (pass-if "rec expressions"
     (let ((ones-list (rec ones (cons 1 (delay ones)))))
       (and (= 1 (car ones-list))
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index d892b7077..679e17326 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -557,7 +557,67 @@
   (pass-if "char 255"
     (equal? '("a" "b")
 	    (string-split (string #\a (integer->char 255) #\b)
-			  (integer->char 255)))))
+			  (integer->char 255))))
+
+  (pass-if "empty string - char"
+    (equal? '("")
+            (string-split "" #\:)))
+
+  (pass-if "non-empty - char - no delimiters"
+    (equal? '("foobarfrob")
+            (string-split "foobarfrob" #\:)))
+
+  (pass-if "non-empty - char - delimiters"
+    (equal? '("foo" "bar" "frob")
+            (string-split "foo:bar:frob" #\:)))
+
+  (pass-if "non-empty - char - leading delimiters"
+    (equal? '("" "" "foo" "bar" "frob")
+            (string-split "::foo:bar:frob" #\:)))
+
+  (pass-if "non-empty - char - trailing delimiters"
+    (equal? '("foo" "bar" "frob" "" "")
+            (string-split "foo:bar:frob::" #\:)))
+
+  (pass-if "empty string - charset"
+    (equal? '("")
+            (string-split "" (char-set #\:))))
+
+  (pass-if "non-empty - charset - no delimiters"
+    (equal? '("foobarfrob")
+            (string-split "foobarfrob" (char-set #\:))))
+
+  (pass-if "non-empty - charset - delimiters"
+    (equal? '("foo" "bar" "frob")
+            (string-split "foo:bar:frob" (char-set #\:))))
+
+  (pass-if "non-empty - charset - leading delimiters"
+    (equal? '("" "" "foo" "bar" "frob")
+            (string-split "::foo:bar:frob" (char-set #\:))))
+
+  (pass-if "non-empty - charset - trailing delimiters"
+    (equal? '("foo" "bar" "frob" "" "")
+            (string-split "foo:bar:frob::" (char-set #\:))))
+
+  (pass-if "empty string - pred"
+    (equal? '("")
+            (string-split "" (negate char-alphabetic?))))
+
+  (pass-if "non-empty - pred - no delimiters"
+    (equal? '("foobarfrob")
+            (string-split "foobarfrob" (negate char-alphabetic?))))
+
+  (pass-if "non-empty - pred - delimiters"
+    (equal? '("foo" "bar" "frob")
+            (string-split "foo:bar:frob" (negate char-alphabetic?))))
+
+  (pass-if "non-empty - pred - leading delimiters"
+    (equal? '("" "" "foo" "bar" "frob")
+            (string-split "::foo:bar:frob" (negate char-alphabetic?))))
+
+  (pass-if "non-empty - pred - trailing delimiters"
+    (equal? '("foo" "bar" "frob" "" "")
+            (string-split "foo:bar:frob::" (negate char-alphabetic?)))))
 
 (with-test-prefix "substring-move!"
 
diff --git a/test-suite/tests/structs.test b/test-suite/tests/structs.test
index 431a014b8..0e3b2417e 100644
--- a/test-suite/tests/structs.test
+++ b/test-suite/tests/structs.test
@@ -126,7 +126,49 @@
      (not (or (equal? (make-ball red "Bob") (make-ball green "Bob"))
 	      (equal? (make-ball red "Bob") (make-ball red "Bill"))))))
 
+
+(with-test-prefix "hash"
+
+  (pass-if "simple structs"
+    (let* ((v  (make-vtable "pr"))
+           (s1 (make-struct v 0 "hello"))
+           (s2 (make-struct v 0 "hello")))
+      (= (hash s1 7777) (hash s2 7777))))
+
+  (pass-if "different structs"
+    (let* ((v  (make-vtable "pr"))
+           (s1 (make-struct v 0 "hello"))
+           (s2 (make-struct v 0 "world")))
+      (or (not (= (hash s1 7777) (hash s2 7777)))
+          (throw 'unresolved))))
+
+  (pass-if "different struct types"
+    (let* ((v1 (make-vtable "pr"))
+           (v2 (make-vtable "pr"))
+           (s1 (make-struct v1 0 "hello"))
+           (s2 (make-struct v2 0 "hello")))
+      (or (not (= (hash s1 7777) (hash s2 7777)))
+          (throw 'unresolved))))
 
+  (pass-if "more complex structs"
+    (let ((s1 (make-ball red (string-copy "Bob")))
+          (s2 (make-ball red (string-copy "Bob"))))
+      (= (hash s1 7777) (hash s2 7777))))
+
+  (pass-if "struct with weird fields"
+    (let* ((v  (make-vtable "prurph"))
+           (s1 (make-struct v 0 "hello" 123 "invisible-secret1"))
+           (s2 (make-struct v 0 "hello" 123 "invisible-secret2")))
+      (= (hash s1 7777) (hash s2 7777))))
+
+  (pass-if "cyclic structs"
+    (let* ((v (make-vtable "pw"))
+           (a (make-struct v 0 #f))
+           (b (make-struct v 0 a)))
+      (struct-set! a 0 b)
+      (and (hash a 7777) (hash b 7777) #t))))
+
+
 ;;
 ;; make-struct
 ;;
diff --git a/test-suite/tests/texinfo.test b/test-suite/tests/texinfo.test
index 98c44b91b..8a4b593fd 100644
--- a/test-suite/tests/texinfo.test
+++ b/test-suite/tests/texinfo.test
@@ -208,9 +208,8 @@
 
   (test-body "@code{arg}"
              '((para (code "arg"))))
-  ;; FIXME: Why no enclosing para here?  Probably a bug.
   (test-body "@url{arg}"
-             '((uref (% (url "arg")))))
+             '((para (uref (% (url "arg"))))))
   (test-body "@code{     }"
              '((para (code))))
   (test-body "@code{ @code{}    }"
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 5d12f0c48..4767d624a 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -58,6 +58,20 @@
      (assert-tree-il->glil with-partial-evaluation
                            in pat test ...))))
 
+(define-syntax-rule (pass-if-primitives-resolved in expected)
+  (pass-if (format #f "primitives-resolved in ~s" 'in)
+    (let* ((module   (let ((m (make-module)))
+                       (beautify-user-module! m)
+                       m))
+           (orig     (parse-tree-il 'in))
+           (resolved (expand-primitives! (resolve-primitives! orig module))))
+      (or (equal? (unparse-tree-il resolved) 'expected)
+          (begin
+            (format (current-error-port)
+                    "primitive test failed: got ~s, expected ~s"
+                    resolved 'expected)
+            #f)))))
+
 (define-syntax pass-if-tree-il->scheme
   (syntax-rules ()
     ((_ in pat)
@@ -70,6 +84,69 @@
          (_ #f))))))
 
 
+(with-test-prefix "primitives"
+
+  (with-test-prefix "eqv?"
+
+    (pass-if-primitives-resolved
+        (primcall eqv? (toplevel x) (const #f))
+      (primcall eq? (const #f) (toplevel x)))
+
+    (pass-if-primitives-resolved
+        (primcall eqv? (toplevel x) (const ()))
+      (primcall eq? (const ()) (toplevel x)))
+
+    (pass-if-primitives-resolved
+        (primcall eqv? (const #t) (lexical x y))
+      (primcall eq? (const #t) (lexical x y)))
+
+    (pass-if-primitives-resolved
+        (primcall eqv? (const this-is-a-symbol) (toplevel x))
+      (primcall eq? (const this-is-a-symbol) (toplevel x)))
+
+    (pass-if-primitives-resolved
+        (primcall eqv? (const 42) (toplevel x))
+      (primcall eq? (const 42) (toplevel x)))
+
+    (pass-if-primitives-resolved
+        (primcall eqv? (const 42.0) (toplevel x))
+      (primcall eqv? (const 42.0) (toplevel x)))
+
+    (pass-if-primitives-resolved
+        (primcall eqv? (const #nil) (toplevel x))
+      (primcall eq? (const #nil) (toplevel x))))
+
+  (with-test-prefix "equal?"
+
+    (pass-if-primitives-resolved
+        (primcall equal? (toplevel x) (const #f))
+      (primcall eq? (const #f) (toplevel x)))
+
+    (pass-if-primitives-resolved
+        (primcall equal? (toplevel x) (const ()))
+      (primcall eq? (const ()) (toplevel x)))
+
+    (pass-if-primitives-resolved
+        (primcall equal? (const #t) (lexical x y))
+      (primcall eq? (const #t) (lexical x y)))
+
+    (pass-if-primitives-resolved
+        (primcall equal? (const this-is-a-symbol) (toplevel x))
+      (primcall eq? (const this-is-a-symbol) (toplevel x)))
+
+    (pass-if-primitives-resolved
+        (primcall equal? (const 42) (toplevel x))
+      (primcall eq? (const 42) (toplevel x)))
+
+    (pass-if-primitives-resolved
+        (primcall equal? (const 42.0) (toplevel x))
+      (primcall equal? (const 42.0) (toplevel x)))
+
+    (pass-if-primitives-resolved
+        (primcall equal? (const #nil) (toplevel x))
+      (primcall eq? (const #nil) (toplevel x)))))
+
+
 (with-test-prefix "tree-il->scheme"
   (pass-if-tree-il->scheme
    (case-lambda ((a) a) ((b c) (list b c)))
@@ -1704,3 +1781,8 @@
                               #:to 'assembly)))))
            (and (= (length w) 1)
                 (number? (string-contains (car w) "unsupported format option"))))))))
+
+;; Local Variables:
+;; eval: (put 'pass-if-primitives-resolved 'scheme-indent-function 1)
+;; eval: (put 'pass-if-tree-il->scheme 'scheme-indent-function 1)
+;; End:
diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test
index 4621a19f9..3f6e7e3ab 100644
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -258,4 +258,6 @@
     (equal? "foo bar" (uri-decode "foo+bar"))))
 
 (with-test-prefix "encode"
-  (pass-if (equal? "foo%20bar" (uri-encode "foo bar"))))
+  (pass-if (equal? "foo%20bar" (uri-encode "foo bar")))
+  (pass-if (equal? "foo%0a%00bar" (uri-encode "foo\n\x00bar")))
+  (pass-if (equal? "%3c%3e%5c%5e" (uri-encode "<>\\^"))))