mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 07:40:30 +02:00
Code Activity

Implement 'set-port-read-option!'.

Browse source 
* libguile/read.c (scm_keyword_prefix, scm_keyword_postfix):
  Rename to 'sym_prefix' and 'sym_postfix'.
  (scm_copy, scm_positions, scm_case_insensitive, sym_keywords,
  sym_r6rs_hex_escapes, sym_square_brackets, sym_hungry_eol_escapes,
  sym_curly_infix, sym_inherit): New variables.
  (scm_set_port_read_option_x): New procedure.
  (init_read_context): Adapt to the renamed 'sym_prefix' and
  'sym_postfix' variables.

* libguile/read.h (scm_set_port_read_option_x): New prototype.

* doc/ref/api-evaluation.texi (Scheme Read): Add docs.
This commit is contained in:
Mark H Weaver 2014-02-02 02:32:15 -05:00
parent 07b820a804
commit 117529ed84
3 changed files with 114 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -345,19 +345,40 @@ 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
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
Guile allows read options to be set on a per-port basis in one of two
ways. One way to do this is by placing reader directives within the
file itself. For example, 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.
unsets @code{square-brackets} on the port (@pxref{SRFI-105}).
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!}.
Alternatively, per-port read options can be set using the following
procedure:
@deffn {Scheme Procedure} set-port-read-option! port option value
@deffnx {C Function} scm_set_port_read_option_x (port, option, value)
Set the per-port read option @var{option} to @var{value} for the given
@var{port}. @var{option} must be one of the symbols listed above.
For the boolean read options, @var{value} must be either a boolean or
the symbol @code{inherit}, which indicates that the setting should be
inherited from the corresponding global read option. For the
@code{keywords} read option, @var{value} must be @code{#f},
@code{prefix}, @code{postfix}, or @code{inherit}.
@end deffn
For example, to enable case-insensitive mode on a given port:
@example
(set-port-read-option! port 'case-insensitive #t)
@end example
It is also possible to set read options globally. The boolean options
may be toggled globally with @code{read-enable} and @code{read-disable}.
The non-boolean @code{keywords} option must be set using @code{read-set!}.
@deffn {Scheme Procedure} read-enable option-name
@deffnx {Scheme Procedure} read-disable option-name

86
libguile/read.c
View file

@ -61,8 +61,8 @@
SCM_GLOBAL_SYMBOL (scm_sym_dot, ".");
SCM_SYMBOL (scm_keyword_prefix, "prefix");
SCM_SYMBOL (scm_keyword_postfix, "postfix");
SCM_SYMBOL (sym_prefix, "prefix");
SCM_SYMBOL (sym_postfix, "postfix");
SCM_SYMBOL (sym_nil, "nil");
/* SRFI-105 curly infix expression support */
@ -2411,6 +2411,84 @@ set_port_read_option (SCM port, int option, int new_value)
scm_i_set_port_property_x (port, sym_port_read_options, scm_read_options);
}
/* Read option symbols */
SCM_SYMBOL (sym_copy, "copy");
SCM_SYMBOL (sym_positions, "positions");
SCM_SYMBOL (sym_case_insensitive, "case-insensitive");
SCM_SYMBOL (sym_keywords, "keywords");
SCM_SYMBOL (sym_r6rs_hex_escapes, "r6rs-hex-escapes");
SCM_SYMBOL (sym_square_brackets, "square-brackets");
SCM_SYMBOL (sym_hungry_eol_escapes, "hungry-eol-escapes");
SCM_SYMBOL (sym_curly_infix, "curly-infix");
SCM_SYMBOL (sym_r7rs_symbols, "r7rs-symbols");
/* Special 'inherit' value for 'set-port-read-option!'. */
SCM_SYMBOL (sym_inherit, "inherit");
SCM_DEFINE (scm_set_port_read_option_x, "set-port-read-option!", 3, 0, 0,
(SCM port, SCM option, SCM value),
"Set the reader option OPTION to VALUE for the given PORT.")
#define FUNC_NAME s_scm_set_port_read_option_x
{
SCM_VALIDATE_OPPORT (1, port);
if (scm_is_eq (option, sym_keywords))
{
int new_value;
if (scm_is_false (value))
new_value = KEYWORD_STYLE_HASH_PREFIX;
else if (scm_is_eq (value, sym_prefix))
new_value = KEYWORD_STYLE_PREFIX;
else if (scm_is_eq (value, sym_postfix))
new_value = KEYWORD_STYLE_POSTFIX;
else if (scm_is_eq (value, sym_inherit))
new_value = READ_OPTION_INHERIT;
else
scm_wrong_type_arg_msg ("set-port-read-option!", 3,
value, "#f, prefix, postfix, or inherit");
set_port_read_option (port, READ_OPTION_KEYWORD_STYLE, new_value);
}
else
{
int option_code, new_value;
if (scm_is_eq (option, sym_copy))
option_code = READ_OPTION_COPY_SOURCE_P;
else if (scm_is_eq (option, sym_positions))
option_code = READ_OPTION_RECORD_POSITIONS_P;
else if (scm_is_eq (option, sym_case_insensitive))
option_code = READ_OPTION_CASE_INSENSITIVE_P;
else if (scm_is_eq (option, sym_r6rs_hex_escapes))
option_code = READ_OPTION_R6RS_ESCAPES_P;
else if (scm_is_eq (option, sym_square_brackets))
option_code = READ_OPTION_SQUARE_BRACKETS_P;
else if (scm_is_eq (option, sym_hungry_eol_escapes))
option_code = READ_OPTION_HUNGRY_EOL_ESCAPES_P;
else if (scm_is_eq (option, sym_curly_infix))
option_code = READ_OPTION_CURLY_INFIX_P;
else if (scm_is_eq (option, sym_r7rs_symbols))
option_code = READ_OPTION_R7RS_SYMBOLS_P;
else
scm_wrong_type_arg_msg ("set-port-read-option!", 2,
option, "valid read option symbol");
if (scm_is_false (value))
new_value = 0;
else if (scm_is_eq (value, SCM_BOOL_T))
new_value = 1;
else if (scm_is_eq (value, sym_inherit))
new_value = READ_OPTION_INHERIT;
else
scm_wrong_type_arg_msg ("set-port-read-option!", 3,
value, "#t, #f, or inherit");
set_port_read_option (port, option_code, new_value);
}
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
/* Set CTX and PORT's case-insensitivity according to VALUE. */
static void
set_port_case_insensitive_p (SCM port, scm_t_read_context *ctx, int value)
@ -2457,9 +2535,9 @@ init_read_context (SCM port, scm_t_read_context *ctx)
if (x == READ_OPTION_INHERIT)
{
val = SCM_PACK (SCM_KEYWORD_STYLE);
if (scm_is_eq (val, scm_keyword_prefix))
if (scm_is_eq (val, sym_prefix))
x = KEYWORD_STYLE_PREFIX;
else if (scm_is_eq (val, scm_keyword_postfix))
else if (scm_is_eq (val, sym_postfix))
x = KEYWORD_STYLE_POSTFIX;
else
x = KEYWORD_STYLE_HASH_PREFIX;

4
libguile/read.h
View file

@ -3,7 +3,8 @@
#ifndef SCM_READ_H
#define SCM_READ_H
/* Copyright (C) 1995,1996,2000, 2006, 2008, 2009 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,2000, 2006, 2008, 2009,
* 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,6 +53,7 @@
SCM_API SCM scm_sym_dot;
SCM_API SCM scm_set_port_read_option_x (SCM port, SCM option, SCM value);
SCM_API SCM scm_read_options (SCM setting);
SCM_API SCM scm_read (SCM port);
SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc);