Re: [PATCH] Implement SRFI-105 curly infix expressions

[Mark H Weaver <mhw@netris.org>]

[-- Attachment #1: Type: text/plain, Size: 914 bytes --]

Hello all,

Here's an improved version of the SRFI-105 patch for Guile 2.0.  It
incorporates the recent name change 'nfx' --> '$nfx$', has an improved
test suite, and now correctly handles the case where 'curly-infix' is
enabled but the 'square-brackets' read option is disabled.

This patch assumes that the following patch set (per-port read options
and reader directives) has already been applied:

  http://lists.gnu.org/archive/html/guile-devel/2012-10/msg00056.html

Note that in the interests of backward compatibility, SRFI-105 syntax is
enabled by default, since '{' and '}' are currently considered "extended
alphabetic characters".  It must first be enabled in one of two ways:

* On a per-port basis, when the reader encounters the "#!curly-infix"
  reader directive, e.g. near the top of source files.

* Globally, by evaluating: (read-enable 'curly-infix)

Reviews solicited.

   Thanks,
     Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Implement SRFI-105 curly infix expressions (v2) --]
[-- Type: text/x-diff, Size: 29250 bytes --]

From 4102fbbd852d2f36e13f0c7f10dbac2017552bff Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Sun, 14 Oct 2012 04:09:01 -0400
Subject: [PATCH] Implement SRFI-105 curly infix expressions.

* libguile/private-options.h: Add SCM_CURLY_INFIX_P macro, and increment
  SCM_N_READ_OPTIONS.

* libguile/read.c (scm_read_opts): Add curly-infix reader option.
  (scm_t_read_opts): Add curly_infix_p field.
  (init_read_options): Initialize new curly_infix_p field.
  (CHAR_IS_DELIMITER): Add '{', '}', '[', and ']' as delimiters if
  curly_infix_p is set.

  (set_per_port_curly_infix_p): New internal static function.

  (scm_read_shebang): Handle '#!curly-infix' reader directive.

  (scm_read, scm_read_keyword, scm_read_vector, scm_read_bytevector):
  Pass new 'neoteric_p' argument to subroutines where needed.

  (scm_read_expression_1): New internal static function, which contains
  the code that was previously in 'scm_read_expression'.  Handle curly
  braces when curly_infix_p is set.  Pass new 'neoteric_p' argument to
  subroutines where needed.

  (scm_read_expression): Add 'neoteric_p' argument.  New function body
  to handle neoteric expressions where appropriate.

  (scm_read_sexp): Add 'neoteric_p' argument.  Handle curly infix
  expressions, converting them to normal s-expressions.

  (flush_ws, scm_read_commented_expression, scm_read_sharp,
  scm_read_quote, scm_read_syntax): Add 'neoteric_p' argument.
  Pass new 'neoteric_p' argument to subroutines where needed.

* doc/ref/srfi-modules.texi (SRFI-105): Add stub doc for SRFI-105.

* doc/ref/api-evaluation.texi (Scheme Read): Add documentation for the
  'curly-infix' read option and the '#!curly-infix' reader directive.

* doc/ref/api-options.texi (Runtime Options): Add 'curly-infix' to the
  list of read options.

* test-suite/Makefile.am: Add tests/srfi-105.test.

* test-suite/tests/srfi-105.test: New file.
---
 doc/ref/api-evaluation.texi    |   10 +-
 doc/ref/api-options.texi       |    1 +
 doc/ref/srfi-modules.texi      |   14 +++
 libguile/private-options.h     |    3 +-
 libguile/read.c                |  231 +++++++++++++++++++++++++++++++---------
 test-suite/Makefile.am         |    1 +
 test-suite/tests/srfi-105.test |   76 +++++++++++++
 7 files changed, 282 insertions(+), 54 deletions(-)
 create mode 100644 test-suite/tests/srfi-105.test

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 9eccb39..245d4e0 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -338,13 +338,15 @@ 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 overriding
-read options on a per-port basis.  Currently, the only read option that
-is overridden in this way is the @code{case-insensitive} option, which
-is set or unset when the reader encounters the special directives
-@code{#!fold-case} or @code{#!no-fold-case}.  There is currently no
+read options on a per-port basis.  The only read options that can
+currently be overridden in this way are the @code{case-insensitive} and
+@code{curly-infix} options, which are set (or unset) when the reader
+encounters the special directives @code{#!fold-case},
+@code{#!no-fold-case}, or @code{#!curly-infix}.  There is currently no
 other way to access or set these per-port read options.
 
 The boolean options may be toggled with @code{read-enable} and
diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi
index f635978..1734318 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/srfi-modules.texi b/doc/ref/srfi-modules.texi
index ba701a2..bf7b3f2 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
 
 
@@ -4469,6 +4470,19 @@ 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 expressions
+@cindex curly-infix
+
+Guile's built-in reader includes support for SRFI-105 curly infix
+expressions.  To enable curly infix expressions, place the reader
+directive @code{#!curly-infix} near the top of each source file.  To
+globally enable curly infix expressions in Guile's reader, set the
+@code{curly-infix} reader option.  For more information on reader
+options, @xref{Scheme Read}.
+
 @c srfi-modules.texi ends here
 
 @c Local Variables:
diff --git a/libguile/private-options.h b/libguile/private-options.h
index 9d2d43c..ed0f314 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 da51a05..5a3cdb4 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -63,6 +63,10 @@ SCM_SYMBOL (scm_keyword_prefix, "prefix");
 SCM_SYMBOL (scm_keyword_postfix, "postfix");
 SCM_SYMBOL (sym_nil, "nil");
 
+/* SRFI-105 curly infix expression support */
+SCM_SYMBOL (sym_nfx, "$nfx$");
+SCM_SYMBOL (sym_bracket_apply, "$bracket-apply$");
+
 scm_t_option scm_read_opts[] = {
   { SCM_OPTION_BOOLEAN, "copy", 0,
     "Copy source code expressions." },
@@ -78,6 +82,8 @@ scm_t_option scm_read_opts[] = {
     "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, },
 };
 
@@ -96,6 +102,7 @@ typedef struct {
   char r6rs_escapes_p;
   char square_brackets_p;
   char hungry_eol_escapes_p;
+  char curly_infix_p;
 } scm_t_read_opts;
 
 /*
@@ -129,7 +136,8 @@ SCM_SYMBOL (sym_read_option_overrides, "%read-option-overrides%");
 #define OVERRIDE_SHIFT_R6RS_ESCAPES_P         8
 #define OVERRIDE_SHIFT_SQUARE_BRACKETS_P     10
 #define OVERRIDE_SHIFT_HUNGRY_EOL_ESCAPES_P  12
-#define OVERRIDES_SHIFT_END                  14
+#define OVERRIDE_SHIFT_CURLY_INFIX_P         14
+#define OVERRIDES_SHIFT_END                  16
 
 #define OVERRIDES_ALL_DEFAULTS  ((1UL << OVERRIDES_SHIFT_END) - 1)
 #define OVERRIDES_MAX_VALUE     OVERRIDES_ALL_DEFAULTS
@@ -168,6 +176,15 @@ set_per_port_case_insensitive_p (SCM port, scm_t_read_opts *opts, int value)
   set_per_port_read_option (port, OVERRIDE_SHIFT_CASE_INSENSITIVE_P, value);
 }
 
+/* Set curly_infix_p on a per-port basis. */
+static void
+set_per_port_curly_infix_p (SCM port, scm_t_read_opts *opts, int value)
+{
+  value = !!value;
+  opts->curly_infix_p = value;
+  set_per_port_read_option (port, OVERRIDE_SHIFT_CURLY_INFIX_P, value);
+}
+
 /* Initialize the internal read options structure from the global and
    per-port read options. */
 static void
@@ -214,6 +231,7 @@ init_read_options (SCM port, scm_t_read_opts *opts)
   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
 }
@@ -330,7 +348,9 @@ scm_i_read_hash_procedures_set_x (SCM value)
 
 #define CHAR_IS_DELIMITER(c)                                    \
   (CHAR_IS_R5RS_DELIMITER (c)                                   \
-   || (opts->square_brackets_p && ((c) == ']' || (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''.  */
@@ -341,7 +361,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, scm_t_read_opts *);
+static SCM scm_read_commented_expression (scm_t_wchar, SCM,
+                                          scm_t_read_opts *, int);
 static SCM scm_read_shebang (scm_t_wchar, SCM, scm_t_read_opts *);
 static SCM scm_get_hash_procedure (int);
 
@@ -427,7 +448,7 @@ read_complete_token (SCM port, scm_t_read_opts *opts,
 /* 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, scm_t_read_opts *opts, const char *eoferr)
+flush_ws (SCM port, scm_t_read_opts *opts, int neoteric_p, const char *eoferr)
 {
   scm_t_wchar c;
   while (1)
@@ -467,7 +488,7 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr)
 	    scm_read_shebang (c, port, opts);
 	    break;
 	  case ';':
-	    scm_read_commented_expression (c, port, opts);
+	    scm_read_commented_expression (c, port, opts, neoteric_p);
 	    break;
 	  case '|':
 	    if (scm_is_false (scm_get_hash_procedure (c)))
@@ -498,9 +519,10 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr)
 \f
 /* Token readers.  */
 
-static SCM scm_read_expression (SCM port, scm_t_read_opts *opts);
+static SCM scm_read_expression (SCM port, scm_t_read_opts *opts,
+                                int neoteric_p);
 static SCM scm_read_sharp (int chr, SCM port, scm_t_read_opts *opts,
-                           long line, int column);
+                           int neoteric_p, long line, int column);
 
 
 static SCM
@@ -513,31 +535,35 @@ maybe_annotate_source (SCM x, SCM port, scm_t_read_opts *opts,
 }
 
 static SCM
-scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
+scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts, int neoteric_p)
 #define FUNC_NAME "scm_i_lreadparen"
 {
   int c;
   SCM tmp, tl, ans = SCM_EOL;
-  const int terminating_char = ((chr == '[') ? ']' : ')');
+  const int curly_infix_p = (chr == '{');
+  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, opts, FUNC_NAME);
+  c = flush_ws (port, opts, neoteric_p, FUNC_NAME);
   if (terminating_char == c)
     return SCM_EOL;
 
   scm_ungetc (c, port);
-  tmp = scm_read_expression (port, opts);
+  tmp = scm_read_expression (port, opts, neoteric_p);
 
   /* 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, opts);
-      if (terminating_char != (c = flush_ws (port, opts, FUNC_NAME)))
+      ans = scm_read_expression (port, opts, neoteric_p);
+      if (terminating_char != (c = flush_ws (port, opts, neoteric_p,
+                                             FUNC_NAME)))
 	scm_i_input_error (FUNC_NAME, port, "missing close paren",
 			   SCM_EOL);
       return ans;
@@ -546,28 +572,30 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   /* Build the head of the list structure. */
   ans = tl = scm_cons (tmp, SCM_EOL);
 
-  while (terminating_char != (c = flush_ws (port, opts, FUNC_NAME)))
+  while (terminating_char != (c = flush_ws (port, opts, neoteric_p,
+                                            FUNC_NAME)))
     {
       SCM new_tail;
 
-      if (c == ')' || (opts->square_brackets_p && c == ']'))
+      if (c == ')' || (opts->square_brackets_p && c == ']')
+          || (opts->curly_infix_p && (c == '}' || c == ']')))
         scm_i_input_error (FUNC_NAME, port,
                            "in pair: mismatched close paren: ~A",
                            scm_list_1 (SCM_MAKE_CHAR (c)));
 
       scm_ungetc (c, port);
-      tmp = scm_read_expression (port, opts);
+      tmp = scm_read_expression (port, opts, neoteric_p);
 
       /* See above note about scm_sym_dot.  */
       if (c == '.' && scm_is_eq (scm_sym_dot, tmp))
 	{
-	  SCM_SETCDR (tl, scm_read_expression (port, opts));
+	  SCM_SETCDR (tl, scm_read_expression (port, opts, neoteric_p));
 
-	  c = flush_ws (port, opts, FUNC_NAME);
+	  c = flush_ws (port, opts, neoteric_p, 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);
@@ -575,8 +603,51 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
       tl = new_tail;
     }
 
- exit:
-  return maybe_annotate_source (ans, port, opts, line, column);
+  if (curly_infix_p)
+    {
+      int len = scm_ilength (ans);
+
+      if (len == 1)
+        ans = scm_car (ans);
+      else if (len == 2)
+        ;  /* Leave the list unchanged */
+      else if (len >= 3 && (len & 1))
+        {
+          SCM op = scm_cadr (ans);
+
+          /* Verify that all infix operators are 'equal?' */
+          for (tl = scm_cdddr (ans); ; tl = scm_cddr (tl))
+            {
+              if (scm_is_null (tl))
+                {
+                  tl = ans;
+
+                  /* Convert simple curly-infix list to prefix */
+                  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 */
+                  ans = scm_cons (sym_nfx, ans);
+                  break;
+                }
+            }
+        }
+      else
+        ans = scm_cons (sym_nfx, ans);  /* Mixed curly-infix list */
+    }
+
+  if (SCM_NIMP (ans))
+    return maybe_annotate_source (ans, port, opts, line, column);
+  else
+    return ans;
 }
 #undef FUNC_NAME
 
@@ -875,7 +946,7 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 #undef FUNC_NAME
 
 static SCM
-scm_read_quote (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_quote (int chr, SCM port, scm_t_read_opts *opts, int neoteric_p)
 {
   SCM p;
   long line = SCM_LINUM (port);
@@ -912,7 +983,7 @@ scm_read_quote (int chr, SCM port, scm_t_read_opts *opts)
       abort ();
     }
 
-  p = scm_cons2 (p, scm_read_expression (port, opts), SCM_EOL);
+  p = scm_cons2 (p, scm_read_expression (port, opts, neoteric_p), SCM_EOL);
   return maybe_annotate_source (p, port, opts, line, column);
 }
 
@@ -922,7 +993,7 @@ SCM_SYMBOL (sym_unsyntax, "unsyntax");
 SCM_SYMBOL (sym_unsyntax_splicing, "unsyntax-splicing");
 
 static SCM
-scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts, int neoteric_p)
 {
   SCM p;
   long line = SCM_LINUM (port);
@@ -959,7 +1030,7 @@ scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts)
       abort ();
     }
 
-  p = scm_cons2 (p, scm_read_expression (port, opts), SCM_EOL);
+  p = scm_cons2 (p, scm_read_expression (port, opts, neoteric_p), SCM_EOL);
   return maybe_annotate_source (p, port, opts, line, column);
 }
 
@@ -1128,7 +1199,7 @@ scm_read_keyword (int chr, SCM port, scm_t_read_opts *opts)
      to adapt to the delimiters currently valid of symbols.
 
      XXX: This implementation allows sloppy syntaxes like `#:  key'.  */
-  symbol = scm_read_expression (port, opts);
+  symbol = scm_read_expression (port, opts, 0);
   if (!scm_is_symbol (symbol))
     scm_i_input_error ("scm_read_keyword", port,
 		       "keyword prefix `~a' not followed by a symbol: ~s",
@@ -1145,8 +1216,9 @@ scm_read_vector (int chr, SCM port, scm_t_read_opts *opts,
      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, opts)),
-                                port, opts, line, column);
+  return maybe_annotate_source
+    (scm_vector (scm_read_sexp (chr, port, opts, 0)),
+     port, opts, line, column);
 }
 
 static SCM
@@ -1184,7 +1256,7 @@ scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
     goto syntax;
 
   return maybe_annotate_source
-    (scm_u8_list_to_bytevector (scm_read_sexp (chr, port, opts)),
+    (scm_u8_list_to_bytevector (scm_read_sexp (chr, port, opts, 0)),
      port, opts, line, column);
 
  syntax:
@@ -1267,6 +1339,8 @@ scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
             set_per_port_case_insensitive_p (port, opts, 1);
           else if (0 == strcmp ("no-fold-case", name))
             set_per_port_case_insensitive_p (port, opts, 0);
+          else if (0 == strcmp ("curly-infix", name))
+            set_per_port_curly_infix_p (port, opts, 1);
           else
             break;
 
@@ -1318,16 +1392,16 @@ scm_read_r6rs_block_comment (scm_t_wchar chr, SCM port)
 
 static SCM
 scm_read_commented_expression (scm_t_wchar chr, SCM port,
-                               scm_t_read_opts *opts)
+                               scm_t_read_opts *opts, int neoteric_p)
 {
   scm_t_wchar c;
   
-  c = flush_ws (port, opts, (char *) NULL);
+  c = flush_ws (port, opts, neoteric_p, (char *) NULL);
   if (EOF == c)
     scm_i_input_error ("read_commented_expression", port,
                        "no expression after #; comment", SCM_EOL);
   scm_ungetc (c, port);
-  scm_read_expression (port, opts);
+  scm_read_expression (port, opts, neoteric_p);
   return SCM_UNSPECIFIED;
 }
 
@@ -1456,7 +1530,7 @@ scm_read_sharp_extension (int chr, SCM port, scm_t_read_opts *opts)
    among the above token readers.   */
 static SCM
 scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
-                long line, int column)
+                int neoteric_p, long line, int column)
 #define FUNC_NAME "scm_lreadr"
 {
   SCM result;
@@ -1531,11 +1605,11 @@ scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
     case '!':
       return (scm_read_shebang (chr, port, opts));
     case ';':
-      return (scm_read_commented_expression (chr, port, opts));
+      return (scm_read_commented_expression (chr, port, opts, neoteric_p));
     case '`':
     case '\'':
     case ',':
-      return (scm_read_syntax (chr, port, opts));
+      return (scm_read_syntax (chr, port, opts, neoteric_p));
     case 'n':
       return (scm_read_nil (chr, port, opts));
     default:
@@ -1563,8 +1637,8 @@ scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
 #undef FUNC_NAME
 
 static SCM
-scm_read_expression (SCM port, scm_t_read_opts *opts)
-#define FUNC_NAME "scm_read_expression"
+scm_read_expression_1 (SCM port, scm_t_read_opts *opts, int neoteric_p)
+#define FUNC_NAME "scm_read_expression_1"
 {
   while (1)
     {
@@ -1580,23 +1654,42 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
 	case ';':
 	  (void) scm_read_semicolon_comment (chr, port);
 	  break;
+        case '{':
+          if (opts->curly_infix_p)
+            return (scm_read_sexp (chr, port, opts, 1));
+          else
+            return (scm_read_mixed_case_symbol (chr, port, opts));
+        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 (!opts->square_brackets_p)
+          if (opts->square_brackets_p)
+            return (scm_read_sexp (chr, port, opts, neoteric_p));
+          else 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 (opts->square_brackets_p || opts->curly_infix_p)
+            scm_i_input_error (FUNC_NAME, port, "unexpected \"]\"", SCM_EOL);
+          else
             return (scm_read_mixed_case_symbol (chr, port, opts));
-          /* otherwise fall through */
 	case '(':
-	  return (scm_read_sexp (chr, port, opts));
+	  return (scm_read_sexp (chr, port, opts, neoteric_p));
 	case '"':
 	  return (scm_read_string (chr, port, opts));
 	case '\'':
 	case '`':
 	case ',':
-	  return (scm_read_quote (chr, port, opts));
+	  return (scm_read_quote (chr, port, opts, neoteric_p));
 	case '#':
 	  {
             long line  = SCM_LINUM (port);
             int column = SCM_COL (port) - 1;
-	    SCM result = scm_read_sharp (chr, port, opts, line, column);
+            SCM result = scm_read_sharp (chr, port, opts, neoteric_p,
+                                         line, column);
 	    if (scm_is_eq (result, SCM_UNSPECIFIED))
 	      /* We read a comment or some such.  */
 	      break;
@@ -1606,15 +1699,12 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
 	case ')':
 	  scm_i_input_error (FUNC_NAME, port, "unexpected \")\"", SCM_EOL);
 	  break;
-	case ']':
-          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 (opts->keyword_style == KEYWORD_STYLE_PREFIX)
-	    return scm_symbol_to_keyword (scm_read_expression (port, opts));
+	    return scm_symbol_to_keyword
+              (scm_read_expression (port, opts, neoteric_p));
 	  /* Fall through.  */
 
 	default:
@@ -1630,6 +1720,49 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
 }
 #undef FUNC_NAME
 
+static SCM
+scm_read_expression (SCM port, scm_t_read_opts *opts, int neoteric_p)
+#define FUNC_NAME "scm_read_expression"
+{
+  if (!neoteric_p)
+    return scm_read_expression_1 (port, opts, 0);
+  else
+    {
+      long line = SCM_LINUM (port);
+      int column = SCM_COL (port) - 1;
+      SCM expr = scm_read_expression_1 (port, opts, 1);
+
+      for (;;)
+        {
+          int chr = scm_getc (port);
+
+          if (chr == '(')
+            expr = scm_cons (expr, scm_read_sexp (chr, port, opts, 1));
+          else if (chr == '[')
+            expr = scm_cons (sym_bracket_apply,
+                             scm_cons (expr,
+                                       scm_read_sexp (chr, port, opts, 1)));
+          else if (chr == '{')
+            {
+              SCM arg = scm_read_sexp (chr, port, opts, 1);
+
+              if (scm_is_null (arg))
+                expr = scm_list_1 (expr);
+              else
+                expr = scm_list_2 (expr, arg);
+            }
+          else
+            {
+              scm_ungetc (chr, port);
+              break;
+            }
+          maybe_annotate_source (expr, port, opts, line, column);
+        }
+      return expr;
+    }
+}
+#undef FUNC_NAME
+
 \f
 /* Actual reader.  */
 
@@ -1649,12 +1782,12 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
 
   init_read_options (port, &opts);
 
-  c = flush_ws (port, &opts, (char *) NULL);
+  c = flush_ws (port, &opts, 0, (char *) NULL);
   if (EOF == c)
     return SCM_EOF_VAL;
   scm_ungetc (c, port);
 
-  return (scm_read_expression (port, &opts));
+  return (scm_read_expression (port, &opts, 0));
 }
 #undef FUNC_NAME
 
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 168e799..a843fcd 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/srfi-105.test b/test-suite/tests/srfi-105.test
new file mode 100644
index 0000000..a0ed0ee
--- /dev/null
+++ b/test-suite/tests/srfi-105.test
@@ -0,0 +1,76 @@
+;;;; 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
+
+#!curly-infix
+
+(define-module (test-srfi-105)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-1))
+
+(with-test-prefix "curly-infix"
+  (pass-if (equal? '{n <= 5}                '(<= n 5)))
+  (pass-if (equal? '{a + b + c}             '(+ a b c)))
+  (pass-if (equal? '{x ,op y ,op z}         '(,op x y z)))
+  (pass-if (equal? '{a * {b + c}}           '(* a (+ b c))))
+  (pass-if (equal? '{x eqv? `a}             '(eqv? x `a)))
+  (pass-if (equal? '{(- a) / b}             '(/ (- a) b)))
+  (pass-if (equal? '{-(a) / b}              '(/ (- a) b)))
+  (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? '{f(g(x))}               '(f (g x))))
+  (pass-if (equal? '{f(g(x) h(x))}          '(f (g x) (h x))))
+  (pass-if (equal? '{ (f (g h(x))) }        '(f (g (h x)))))
+
+  ;; FIXME Unsure about this one!  I've asked for clarification. -mhw
+  (pass-if (equal? '{ (f #(g h(x))) }       '(f #(g h (x)))))
+
+  (pass-if (equal? '{ (f #;g(x) h(x)) }     '(f (h x))))
+
+  (pass-if (equal? '{a + f(b) + x}          '(+ a (f b) x)))
+  (pass-if (equal? '{{a > 0} and {b >= 1}}  '(and (> a 0) (>= b 1))))
+  (pass-if (equal? '{'f(x)}                 '(quote (f x))))
+  ;;(pass-if (equal? '#1=f(#1#)               '#1=(f #1#)))
+  (pass-if (equal? '{length(x) >= 6}        '(>= (length x) 6)))
+
+  (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)))
+  ;;(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? '{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))))
-- 
1.7.10.4