guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. v2.1.0-601-gc92ee2b


From: Mark H Weaver
Subject: [Guile-commits] GNU Guile branch, master, updated. v2.1.0-601-gc92ee2b
Date: Wed, 15 Jan 2014 04:00:26 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c92ee2b38cb1ace800de081c9211120afea0c595

The branch, master has been updated
       via  c92ee2b38cb1ace800de081c9211120afea0c595 (commit)
       via  6e504a7b44a9a25787bdfb2d86fdddd3029f4ba9 (commit)
       via  dc59631d3094ad39bba5e40d5c36200fb99023f9 (commit)
       via  b306fae0abe38aac6fede98727a47f57a4ba992f (commit)
      from  cb8aaef4d08989aea2b7f088d298f71a03ecc1b2 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit c92ee2b38cb1ace800de081c9211120afea0c595
Merge: cb8aaef 6e504a7
Author: Mark H Weaver <address@hidden>
Date:   Tue Jan 14 22:23:39 2014 -0500

    Merge branch 'stable-2.0'
    
    Conflicts:
        libguile/print.c
        libguile/read.c
        test-suite/tests/print.test

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/api-data.texi        |   10 +++++
 doc/ref/api-evaluation.texi  |   10 ++++-
 doc/ref/srfi-modules.texi    |    9 +++++
 libguile/print.c             |   75 ++++++++++++++++++++++++++++++++++++++----
 libguile/private-options.h   |    8 +++--
 libguile/read.c              |   40 +++++++++++++++++++---
 module/ice-9/boot-9.scm      |    1 +
 test-suite/tests/print.test  |   56 ++++++++++++++++++++++++++++++-
 test-suite/tests/reader.test |    5 +++
 9 files changed, 195 insertions(+), 19 deletions(-)

diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 1a3d2e8..c73a703 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -5588,6 +5588,16 @@ Although Guile provides this extended read syntax for 
symbols,
 widespread usage of it is discouraged because it is not portable and not
 very readable.
 
+Alternatively, if you enable the @code{r7rs-symbols} read option (see
address@hidden Read}), you can write arbitrary symbols using the same
+notation used for strings, except delimited by vertical bars instead of
+double quotes.
+
address@hidden
+|foo bar|
+|\x3BB; is a greek lambda|
+|\| is a vertical bar|
address@hidden example
 
 @node Symbol Uninterned
 @subsubsection Uninterned Symbols
diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 1810fe8..aa3729c 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -1,7 +1,7 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 
2006, 2009, 2010, 2011, 2012, 2013
address@hidden   Free Software Foundation, Inc.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 
2006, 2009,
address@hidden   2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @node Read/Load/Eval/Compile
@@ -340,6 +340,7 @@ 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.
+r7rs-symbols      no    Support R7RS |...| symbol notation.
 @end smalllisp
 
 Note that Guile also includes a preliminary mechanism for setting read
@@ -377,6 +378,9 @@ For example, to make @code{read} fold all symbols to their 
lower case
 For more information on the effect of the @code{r6rs-hex-escapes} and
 @code{hungry-eol-escapes} options, see (@pxref{String Syntax}).
 
+For more information on the @code{r7rs-symbols} option, see
+(@pxref{Symbol Read Syntax}).
+
 
 @node Scheme Write
 @subsection Writing Scheme Values
@@ -436,6 +440,8 @@ quote-keywordish-symbols  reader  How to print symbols that 
have a colon
                                   not '#f'.
 escape-newlines           yes     Render newlines as \n when printing
                                   using `write'. 
+r7rs-symbols              no      Escape symbols using R7RS |...| symbol
+                                  notation.
 @end smalllisp
 
 These options may be modified with the print-set! syntax.
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 3b73c08..0eb20d9 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -51,6 +51,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-55::                     Requiring Features.
 * SRFI-60::                     Integers as bits.
 * SRFI-61::                     A more general `cond' clause
+* SRFI-62::                     S-expression comments.
 * SRFI-67::                     Compare procedures
 * SRFI-69::                     Basic hash tables.
 * SRFI-88::                     Keyword objects.
@@ -155,6 +156,7 @@ srfi-30
 srfi-39
 srfi-55
 srfi-61
+srfi-62
 srfi-105
 @end example
 
@@ -4829,6 +4831,13 @@ success.  SRFI 61 is implemented in the Guile core; 
there's no module
 needed to get SRFI-61 itself.  Extended @code{cond} is documented in
 @ref{Conditionals,, Simple Conditional Evaluation}.
 
address@hidden SRFI-62
address@hidden SRFI-62 - S-expression comments.
address@hidden SRFI-62
+
+Starting from version 2.0, Guile's @code{read} supports SRFI-62/R7RS
+S-expression comments by default.
+
 @node SRFI-67
 @subsection SRFI-67 - Compare procedures
 @cindex SRFI-67
diff --git a/libguile/print.c b/libguile/print.c
index a8f220b..4fe9b77 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995-1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013, 2014 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
@@ -113,6 +113,8 @@ scm_t_option scm_print_opts[] = {
     "'reader' quotes them when the reader option 'keywords' is not '#f'." },
   { SCM_OPTION_BOOLEAN, "escape-newlines", 1,
     "Render newlines as \\n when printing using `write'." },
+  { SCM_OPTION_BOOLEAN, "r7rs-symbols", 0,
+    "Escape symbols using R7RS |...| symbol notation." },
   { 0 },
 };
 
@@ -359,6 +361,13 @@ symbol_has_extended_read_syntax (SCM sym)
     case '#':
       /* Some initial-character constraints.  */
       return 1;
+
+    case '|':
+    case '\\':
+      /* R7RS allows neither '|' nor '\' in bare symbols.  */
+      if (SCM_PRINT_R7RS_SYMBOLS_P)
+        return 1;
+      break;
   
     case ':':
       /* Symbols that look like keywords.  */
@@ -409,6 +418,9 @@ symbol_has_extended_read_syntax (SCM sym)
         return 1;
       else if (c == '"' || c == ';' || c == '#')
         return 1;
+      else if ((c == '|' || c == '\\') && SCM_PRINT_R7RS_SYMBOLS_P)
+        /* R7RS allows neither '|' nor '\' in bare symbols.  */
+        return 1;
     }
 
   return 0;
@@ -456,23 +468,72 @@ print_extended_symbol (SCM sym, SCM port)
         }
       else
         {
-          display_string ("\\x", 1, 2, port, iconveh_question_mark);
+          scm_lfwrite_unlocked ("\\x", 2, port);
           scm_intprint (c, 16, port);
-          display_character (';', port, iconveh_question_mark);
+          scm_putc_unlocked (';', port);
         }
     }
 
   scm_lfwrite_unlocked ("}#", 2, port);
 }
 
-/* FIXME: allow R6RS hex escapes instead of #{...}#.  */
+static void
+print_r7rs_extended_symbol (SCM sym, SCM port)
+{
+  size_t pos, len;
+  scm_t_string_failed_conversion_handler strategy;
+
+  len = scm_i_symbol_length (sym);
+  strategy = PORT_CONVERSION_HANDLER (port);
+
+  scm_putc_unlocked ('|', port);
+
+  for (pos = 0; pos < len; pos++)
+    {
+      scm_t_wchar c = scm_i_symbol_ref (sym, pos);
+
+      switch (c)
+        {
+        case '\a': scm_lfwrite_unlocked ("\\a", 2, port); break;
+        case '\b': scm_lfwrite_unlocked ("\\b", 2, port); break;
+        case '\t': scm_lfwrite_unlocked ("\\t", 2, port); break;
+        case '\n': scm_lfwrite_unlocked ("\\n", 2, port); break;
+        case '\r': scm_lfwrite_unlocked ("\\r", 2, port); break;
+        case '|':  scm_lfwrite_unlocked ("\\|", 2, port); break;
+        case '\\': scm_lfwrite_unlocked ("\\x5c;", 5, port); break;
+        default:
+          if (uc_is_general_category_withtable (c,
+                                                SUBSEQUENT_IDENTIFIER_MASK
+                                                | UC_CATEGORY_MASK_Zs))
+            {
+              if (!display_character (c, port, strategy))
+                scm_encoding_error ("print_r7rs_extended_symbol", errno,
+                                    "cannot convert to output locale",
+                                    port, SCM_MAKE_CHAR (c));
+            }
+          else
+            {
+              scm_lfwrite_unlocked ("\\x", 2, port);
+              scm_intprint (c, 16, port);
+              scm_putc_unlocked (';', port);
+            }
+          break;
+        }
+    }
+
+  scm_putc_unlocked ('|', port);
+}
+
+/* FIXME: allow R6RS hex escapes instead of #{...}# or |...|.  */
 static void
 print_symbol (SCM sym, SCM port)
 {
-  if (symbol_has_extended_read_syntax (sym))
-    print_extended_symbol (sym, port);
-  else
+  if (!symbol_has_extended_read_syntax (sym))
     print_normal_symbol (sym, port);
+  else if (SCM_PRINT_R7RS_SYMBOLS_P)
+    print_r7rs_extended_symbol (sym, port);
+  else
+    print_extended_symbol (sym, port);
 }
 
 void
diff --git a/libguile/private-options.h b/libguile/private-options.h
index 4f580a6..a3a0c2b 100644
--- a/libguile/private-options.h
+++ b/libguile/private-options.h
@@ -4,7 +4,7 @@
  * We put this in a private header, since layout of data structures
  * is an implementation detail that we want to hide.
  * 
- * Copyright (C) 2007, 2009, 2010, 2011 Free Software Foundation, Inc.
+ * Copyright (C) 2007, 2009, 2010, 2011, 2014 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
@@ -52,7 +52,8 @@ SCM_INTERNAL scm_t_option scm_print_opts[];
 #define SCM_PRINT_KEYWORD_STYLE_I   2
 #define SCM_PRINT_KEYWORD_STYLE     (SCM_PACK (scm_print_opts[2].val))
 #define SCM_PRINT_ESCAPE_NEWLINES_P scm_print_opts[3].val
-#define SCM_N_PRINT_OPTIONS 4
+#define SCM_PRINT_R7RS_SYMBOLS_P    scm_print_opts[4].val
+#define SCM_N_PRINT_OPTIONS 5
 
 
 /*
@@ -68,7 +69,8 @@ SCM_INTERNAL scm_t_option scm_read_opts[];
 #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_R7RS_SYMBOLS_P     scm_read_opts[8].val
 
-#define SCM_N_READ_OPTIONS 8
+#define SCM_N_READ_OPTIONS 9
 
 #endif  /* PRIVATE_OPTIONS */ 
diff --git a/libguile/read.c b/libguile/read.c
index b3e6eeb..980769b 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -88,6 +88,8 @@ scm_t_option scm_read_opts[] =
       "In strings, consume leading whitespace after an escaped end-of-line."},
     { SCM_OPTION_BOOLEAN, "curly-infix", 0,
       "Support SRFI-105 curly infix expressions."},
+    { SCM_OPTION_BOOLEAN, "r7rs-symbols", 0,
+      "Support R7RS |...| symbol notation."},
     { 0, },
   };
  
@@ -113,6 +115,7 @@ struct t_read_opts
   unsigned int hungry_eol_escapes_p : 1;
   unsigned int curly_infix_p        : 1;
   unsigned int neoteric_p           : 1;
+  unsigned int r7rs_symbols_p       : 1;
 };
 
 typedef struct t_read_opts scm_t_read_opts;
@@ -588,8 +591,11 @@ skip_intraline_whitespace (SCM port)
   scm_ungetc_unlocked (c, port);
 }                                         
 
+/* Read either a double-quoted string or an R7RS-style symbol delimited
+   by vertical lines, depending on the value of 'chr' ('"' or '|').
+   Regardless, the result is always returned as a string.  */
 static SCM
-scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_string_like_syntax (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
@@ -603,13 +609,16 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
   long line = SCM_LINUM (port);
   int column = SCM_COL (port) - 1;
 
-  while ('"' != (c = scm_getc_unlocked (port)))
+  while (chr != (c = scm_getc_unlocked (port)))
     {
       if (c == EOF)
         {
         str_eof:
           scm_i_input_error (FUNC_NAME, port,
-                             "end of file in string constant", SCM_EOL);
+                             (chr == '|'
+                              ? "end of file in symbol"
+                              : "end of file in string constant"),
+                             SCM_EOL);
         }
 
       if (c_str_len + 1 >= READER_STRING_BUFFER_SIZE)
@@ -624,7 +633,6 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
             {
             case EOF:
               goto str_eof;
-            case '"':
             case '|':
             case '\\':
               break;
@@ -657,7 +665,7 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
               c = '\010';
               break;
             case 'x':
-              if (opts->r6rs_escapes_p)
+              if (opts->r6rs_escapes_p || chr == '|')
                 SCM_READ_HEX_ESCAPE (10, ';');
               else
                 SCM_READ_HEX_ESCAPE (2, '\0');
@@ -675,6 +683,8 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
                   break;
                 }
             default:
+              if (c == chr)
+                break;
             bad_escaped:
               scm_i_input_error (FUNC_NAME, port,
                                  "illegal character in escape sequence: ~S",
@@ -700,6 +710,17 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
 }
 #undef FUNC_NAME
 
+static SCM
+scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
+{
+  return scm_read_string_like_syntax (chr, port, opts);
+}
+
+static SCM
+scm_read_r7rs_symbol (int chr, SCM port, scm_t_read_opts *opts)
+{
+  return scm_string_to_symbol (scm_read_string_like_syntax (chr, port, opts));
+}
 
 static SCM
 scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
@@ -1764,6 +1785,11 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
          return (scm_read_sexp (chr, port, opts));
        case '"':
          return (scm_read_string (chr, port, opts));
+        case '|':
+          if (opts->r7rs_symbols_p)
+            return scm_read_r7rs_symbol (chr, port, opts);
+          else
+            return scm_read_mixed_case_symbol (chr, port, opts);
        case '\'':
        case '`':
        case ',':
@@ -2186,9 +2212,10 @@ SCM_SYMBOL (sym_port_read_options, "port-read-options");
 #define READ_OPTION_SQUARE_BRACKETS_P     10
 #define READ_OPTION_HUNGRY_EOL_ESCAPES_P  12
 #define READ_OPTION_CURLY_INFIX_P         14
+#define READ_OPTION_R7RS_SYMBOLS_P        16
 
 /* The total width in bits of the per-port overrides */
-#define READ_OPTIONS_NUM_BITS             16
+#define READ_OPTIONS_NUM_BITS             18
 
 #define READ_OPTIONS_INHERIT_ALL  ((1UL << READ_OPTIONS_NUM_BITS) - 1)
 #define READ_OPTIONS_MAX_VALUE    READ_OPTIONS_INHERIT_ALL
@@ -2292,6 +2319,7 @@ init_read_options (SCM port, scm_t_read_opts *opts)
   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);
+  RESOLVE_BOOLEAN_OPTION (R7RS_SYMBOLS_P,       r7rs_symbols_p);
 
 #undef RESOLVE_BOOLEAN_OPTION
 
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index bb4cf1f..5b52299 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -4220,6 +4220,7 @@ when none is available, reading FILE-NAME with READER."
     srfi-39  ;; parameterize
     srfi-55  ;; require-extension
     srfi-61  ;; general cond clause
+    srfi-62  ;; s-expression comments
     srfi-105 ;; curly infix expressions
     ))
 
diff --git a/test-suite/tests/print.test b/test-suite/tests/print.test
index 47a1077..7269887 100644
--- a/test-suite/tests/print.test
+++ b/test-suite/tests/print.test
@@ -1,6 +1,6 @@
 ;;;; -*- coding: utf-8; mode: scheme; -*-
 ;;;;
-;;;; Copyright (C) 2010, 2013  Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2013, 2014  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
@@ -29,6 +29,60 @@
                  (lambda ()
                    (pretty-print 'exp)))))))
 
+(define (with-print-options opts thunk)
+  (let ((saved-options (print-options)))
+    (dynamic-wind
+        (lambda ()
+          (print-options opts))
+        thunk
+        (lambda ()
+          (print-options saved-options)))))
+
+(define-syntax-rule (write-with-options opts x)
+  (with-print-options opts (lambda ()
+                             (with-output-to-string
+                               (lambda ()
+                                 (write x))))))
+
+
+(with-test-prefix "write"
+
+  (with-test-prefix "r7rs-symbols"
+
+    (pass-if-equal "basic"
+        "|foo bar|"
+      (write-with-options '(r7rs-symbols)
+                          (string->symbol "foo bar")))
+
+    (pass-if-equal "escapes"
+        "|bar \\| backslash \\x5c; alarm \\a backspace \\b tab \\t newline \\n 
cr \\r null \\x0; del \\x7f;|"
+      (write-with-options
+       '(r7rs-symbols)
+       (string->symbol
+        (string-append
+         "bar | backslash \\ alarm \a backspace \b tab \t newline \n cr \r 
null \0 del "
+         (string #\del)))))
+
+    (pass-if-equal "starts with bar"
+        "|\\|foo|"
+      (write-with-options '(r7rs-symbols)
+                          (string->symbol "|foo")))
+
+    (pass-if-equal "ends with bar"
+        "|foo\\||"
+      (write-with-options '(r7rs-symbols)
+                          (string->symbol "foo|")))
+
+    (pass-if-equal "starts with backslash"
+        "|\\x5c;foo|"
+      (write-with-options '(r7rs-symbols)
+                          (string->symbol "\\foo")))
+
+    (pass-if-equal "ends with backslash"
+        "|foo\\x5c;|"
+      (write-with-options '(r7rs-symbols)
+                          (string->symbol "foo\\")))))
+
 
 (with-test-prefix "pretty-print"
 
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 9f30b4b..d9cb1c8 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -237,6 +237,11 @@
          (with-read-options '(case-insensitive)
            (lambda ()
              (read-string "GuiLe")))))
+  (pass-if-equal "r7rs-symbols"
+      (list 'a (string->symbol "Hello, this is | a \"test\"") 'b)
+    (with-read-options '(r7rs-symbols)
+      (lambda ()
+        (read-string "(a |H\\x65;llo, this is \\| a \"test\"| b)"))))
   (pass-if "prefix keywords"
     (eq? #:keyword
          (with-read-options '(keywords prefix case-insensitive)


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]