Merge branch 'stable-2.0'
authorMark H Weaver <mhw@netris.org>
Wed, 15 Jan 2014 03:23:39 +0000 (22:23 -0500)
committerMark H Weaver <mhw@netris.org>
Wed, 15 Jan 2014 03:23:39 +0000 (22:23 -0500)
Conflicts:
libguile/print.c
libguile/read.c
test-suite/tests/print.test

1  2 
doc/ref/api-data.texi
doc/ref/api-evaluation.texi
doc/ref/srfi-modules.texi
libguile/print.c
libguile/read.c
module/ice-9/boot-9.scm
test-suite/tests/print.test
test-suite/tests/reader.test

Simple merge
Simple merge
Simple merge
@@@ -349,47 -352,25 +351,54 @@@ symbol_has_extended_read_syntax (SCM sy
  
    c = scm_i_symbol_ref (sym, 0);
  
 -  /* Single dot; conflicts with dotted-pair notation.  */
 -  if (len == 1 && c == '.')
 -    return 1;
 -
 -  /* Other initial-character constraints.  */
 -  if (c == '\'' || c == '`' || c == ',' || c == '"' || c == ';' || c == '#')
 -    return 1;
 -
 -  /* R7RS allows neither '|' nor '\' in bare symbols.  */
 -  if ((c == '|' || c == '\\') && SCM_PRINT_R7RS_SYMBOLS_P)
 -    return 1;
 +  switch (c) 
 +    {
 +    case '\'':
 +    case '`':
 +    case ',':
 +    case '"':
 +    case ';':
 +    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;
    
 -  /* Keywords can be identified by trailing colons too.  */
 -  if (c == ':' || scm_i_symbol_ref (sym, len - 1) == ':')
 -    return quote_keywordish_symbols ();
 +    case ':':
 +      /* Symbols that look like keywords.  */
 +      return quote_keywordish_symbols ();
    
 -  /* Number-ish symbols.  */
 -  if (scm_is_true (scm_i_string_to_number (scm_symbol_to_string (sym), 10)))
 -    return 1;
 +    case '.':
 +      /* Single dot conflicts with dotted-pair notation.  */
 +      if (len == 1)
 +        return 1;
 +      /* Fall through to check numbers.  */
 +    case '+':
 +    case '-':
 +    case '0':
 +    case '1':
 +    case '2':
 +    case '3':
 +    case '4':
 +    case '5':
 +    case '6': 
 +    case '7':
 +    case '8':
 +    case '9':
 +     /* Number-ish symbols.  Numbers with radixes already caught be #
 +        above.  */
 +      if (scm_is_true (scm_i_string_to_number (scm_symbol_to_string (sym), 10)))
 +        return 1;
 +      break;
 +
 +    default:
 +      break;
 +    }
    
    /* Other disallowed first characters.  */
    if (!uc_is_general_category_withtable (c, INITIAL_IDENTIFIER_MASK))
@@@ -456,23 -427,72 +468,72 @@@ print_extended_symbol (SCM sym, SCM por
          }
        else
          {
-           display_string ("\\x", 1, 2, port, iconveh_question_mark);
 -          scm_lfwrite ("\\x", 2, port);
++          scm_lfwrite_unlocked ("\\x", 2, port);
            scm_intprint (c, 16, port);
-           display_character (';', port, iconveh_question_mark);
 -          scm_putc (';', port);
++          scm_putc_unlocked (';', port);
          }
      }
  
 -  scm_lfwrite ("}#", 2, 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 ('|', 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 ("\\a", 2, port); break;
 -        case '\b': scm_lfwrite ("\\b", 2, port); break;
 -        case '\t': scm_lfwrite ("\\t", 2, port); break;
 -        case '\n': scm_lfwrite ("\\n", 2, port); break;
 -        case '\r': scm_lfwrite ("\\r", 2, port); break;
 -        case '|':  scm_lfwrite ("\\|", 2, port); break;
 -        case '\\': scm_lfwrite ("\\x5c;", 5, port); break;
++        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 ("\\x", 2, port);
++              scm_lfwrite_unlocked ("\\x", 2, port);
+               scm_intprint (c, 16, port);
 -              scm_putc (';', port);
++              scm_putc_unlocked (';', port);
+             }
+           break;
+         }
+     }
 -  scm_putc ('|', port);
++  scm_putc_unlocked ('|', port);
+ }
+ /* FIXME: allow R6RS hex escapes instead of #{...}# or |...|.  */
 -void
 -scm_i_print_symbol_name (SCM sym, SCM port)
 +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 --cc libguile/read.c
@@@ -585,11 -588,14 +588,14 @@@ skip_intraline_whitespace (SCM port
      }
    while (c == '\t' || uc_is_general_category (c, UC_SPACE_SEPARATOR));
  
 -  scm_ungetc (c, 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
    long line = SCM_LINUM (port);
    int column = SCM_COL (port) - 1;
  
-   while ('"' != (c = scm_getc_unlocked (port)))
 -  while (chr != (c = scm_getc (port)))
++  while (chr != (c = scm_getc_unlocked (port)))
      {
        if (c == EOF)
          {
Simple merge
@@@ -1,6 -1,6 +1,6 @@@
  ;;;; -*- coding: utf-8; mode: scheme; -*-
  ;;;;
- ;;;; Copyright (C) 2010, 2013  Free Software Foundation, Inc.
 -;;;; Copyright (C) 2010, 2014  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
Simple merge