mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Merge branch 'stable-2.0'

Browse source 
Conflicts:
	libguile/print.c
	libguile/read.c
	test-suite/tests/print.test
This commit is contained in:
Mark H Weaver 2014-01-14 22:23:39 -05:00
commit c92ee2b38c
9 changed files with 195 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

10
doc/ref/api-data.texi
View file

@ -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
@pxref{Scheme Read}), you can write arbitrary symbols using the same
notation used for strings, except delimited by vertical bars instead of
double quotes.
@example
|foo bar|
|\x3BB; is a greek lambda|
|\| is a vertical bar|
@end example
@node Symbol Uninterned
@subsubsection Uninterned Symbols

10
doc/ref/api-evaluation.texi
View file

@ -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, 2005, 2006, 2009, 2010, 2011, 2012, 2013
@c Free Software Foundation, Inc.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009,
@c 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.

9
doc/ref/srfi-modules.texi
View file

@ -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}.
@node SRFI-62
@subsection SRFI-62 - S-expression comments.
@cindex 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

75
libguile/print.c
View file

@ -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 },
};
@ -360,6 +362,13 @@ symbol_has_extended_read_syntax (SCM sym)
/* 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. */
return quote_keywordish_symbols ();
@ -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

8
libguile/private-options.h
View file

@ -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 */

40
libguile/read.c
View file

@ -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

1
module/ice-9/boot-9.scm
View file

@ -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
))

56
test-suite/tests/print.test
View file

@ -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"

5
test-suite/tests/reader.test
View file

@ -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)