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

Implement per-port read options.

Browse source 
* libguile/read.c (scm_t_read_opts): Update comment to mention the
  per-port read options.

  (sym_port_read_options): New variable.

  (set_port_read_option): New function.

  (init_read_options): Add new 'port' parameter, and consult the
  per-port read option overrides when initializing the 'scm_t_read_opts'
  struct.  Move to bottom of file.

  (scm_read): Pass 'port' parameter to init_read_options.
This commit is contained in:
Mark H Weaver 2012-10-23 17:28:43 -04:00
parent 851c3cd16e
commit ea8c976155
1 changed files with 123 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

161
libguile/read.c
View file

@ -82,15 +82,18 @@ scm_t_option scm_read_opts[] = {
}; };
/* Internal read options structure. This is initialized by 'scm_read' /* Internal read options structure. This is initialized by 'scm_read'
from the global read options, and a pointer is passed down to all from the global and per-port read options, and a pointer is passed
helper functions. */ down to all helper functions. */
enum t_keyword_style {
KEYWORD_STYLE_HASH_PREFIX,
KEYWORD_STYLE_PREFIX,
KEYWORD_STYLE_POSTFIX
};
struct t_read_opts { enum t_keyword_style
{
KEYWORD_STYLE_HASH_PREFIX,
KEYWORD_STYLE_PREFIX,
KEYWORD_STYLE_POSTFIX
};
struct t_read_opts
{
enum t_keyword_style keyword_style; enum t_keyword_style keyword_style;
unsigned int copy_source_p : 1; unsigned int copy_source_p : 1;
unsigned int record_positions_p : 1; unsigned int record_positions_p : 1;
@ -102,35 +105,6 @@ struct t_read_opts {
typedef struct t_read_opts scm_t_read_opts; typedef struct t_read_opts scm_t_read_opts;
/* Initialize OPTS from the global read options. */
static void
init_read_options (scm_t_read_opts *opts)
{
SCM val;
int x;
val = SCM_PACK (SCM_KEYWORD_STYLE);
if (scm_is_eq (val, scm_keyword_prefix))
x = KEYWORD_STYLE_PREFIX;
else if (scm_is_eq (val, scm_keyword_postfix))
x = KEYWORD_STYLE_POSTFIX;
else
x = KEYWORD_STYLE_HASH_PREFIX;
opts->keyword_style = x;
#define RESOLVE_BOOLEAN_OPTION(NAME, name) \
(opts->name = !!SCM_ ## NAME)
RESOLVE_BOOLEAN_OPTION (COPY_SOURCE_P, copy_source_p);
RESOLVE_BOOLEAN_OPTION (RECORD_POSITIONS_P, record_positions_p);
RESOLVE_BOOLEAN_OPTION (CASE_INSENSITIVE_P, case_insensitive_p);
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);
#undef RESOLVE_BOOLEAN_OPTION
}
/* /*
Give meaningful error messages for errors Give meaningful error messages for errors
@ -1692,6 +1666,8 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
/* Actual reader. */ /* Actual reader. */
static void init_read_options (SCM port, scm_t_read_opts *opts);
SCM_DEFINE (scm_read, "read", 0, 1, 0, SCM_DEFINE (scm_read, "read", 0, 1, 0,
(SCM port), (SCM port),
"Read an s-expression from the input port @var{port}, or from\n" "Read an s-expression from the input port @var{port}, or from\n"
@ -1706,7 +1682,7 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
port = scm_current_input_port (); port = scm_current_input_port ();
SCM_VALIDATE_OPINPORT (1, port); SCM_VALIDATE_OPINPORT (1, port);
init_read_options (&opts); init_read_options (port, &opts);
c = flush_ws (port, &opts, (char *) NULL); c = flush_ws (port, &opts, (char *) NULL);
if (EOF == c) if (EOF == c)
@ -1970,6 +1946,115 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
/* Per-port read options.
We store per-port read options in the 'port-read-options' key of the
port's alist, which is stored in 'scm_i_port_weak_hash'. The value
stored in the alist is a single integer that contains a two-bit field
for each read option.
If a bit field contains READ_OPTION_INHERIT (3), that indicates that
the applicable value should be inherited from the corresponding
global read option. Otherwise, the bit field contains the value of
the read option. For boolean read options that have been set
per-port, the possible values are 0 or 1. If the 'keyword_style'
read option has been set per-port, its possible values are those in
'enum t_keyword_style'. */
/* Key to read options in per-port alists. */
SCM_SYMBOL (sym_port_read_options, "port-read-options");
/* Offsets of bit fields for each per-port override */
#define READ_OPTION_COPY_SOURCE_P 0
#define READ_OPTION_RECORD_POSITIONS_P 2
#define READ_OPTION_CASE_INSENSITIVE_P 4
#define READ_OPTION_KEYWORD_STYLE 6
#define READ_OPTION_R6RS_ESCAPES_P 8
#define READ_OPTION_SQUARE_BRACKETS_P 10
#define READ_OPTION_HUNGRY_EOL_ESCAPES_P 12
#define READ_OPTIONS_NUM_BITS 14
#define READ_OPTIONS_INHERIT_ALL ((1UL << READ_OPTIONS_NUM_BITS) - 1)
#define READ_OPTIONS_MAX_VALUE READ_OPTIONS_INHERIT_ALL
#define READ_OPTION_MASK 3
#define READ_OPTION_INHERIT 3
static void
set_port_read_option (SCM port, int option, int new_value)
{
SCM alist, scm_read_options;
unsigned int read_options;
new_value &= READ_OPTION_MASK;
scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
alist = scm_hashq_ref (scm_i_port_weak_hash, port, SCM_BOOL_F);
scm_read_options = scm_assq_ref (alist, sym_port_read_options);
if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
read_options = scm_to_uint (scm_read_options);
else
read_options = READ_OPTIONS_INHERIT_ALL;
read_options &= ~(READ_OPTION_MASK << option);
read_options |= new_value << option;
scm_read_options = scm_from_uint (read_options);
alist = scm_assq_set_x (alist, sym_port_read_options, scm_read_options);
scm_hashq_set_x (scm_i_port_weak_hash, port, alist);
scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
}
/* Initialize OPTS based on PORT's read options and the global read
options. */
static void
init_read_options (SCM port, scm_t_read_opts *opts)
{
SCM alist, val, scm_read_options;
unsigned int read_options, x;
scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
alist = scm_hashq_ref (scm_i_port_weak_hash, port, SCM_BOOL_F);
scm_read_options = scm_assq_ref (alist, sym_port_read_options);
scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
read_options = scm_to_uint (scm_read_options);
else
read_options = READ_OPTIONS_INHERIT_ALL;
x = READ_OPTION_MASK & (read_options >> READ_OPTION_KEYWORD_STYLE);
if (x == READ_OPTION_INHERIT)
{
val = SCM_PACK (SCM_KEYWORD_STYLE);
if (scm_is_eq (val, scm_keyword_prefix))
x = KEYWORD_STYLE_PREFIX;
else if (scm_is_eq (val, scm_keyword_postfix))
x = KEYWORD_STYLE_POSTFIX;
else
x = KEYWORD_STYLE_HASH_PREFIX;
}
opts->keyword_style = x;
#define RESOLVE_BOOLEAN_OPTION(NAME, name) \
do \
{ \
x = READ_OPTION_MASK & (read_options >> READ_OPTION_ ## NAME); \
if (x == READ_OPTION_INHERIT) \
x = !!SCM_ ## NAME; \
opts->name = x; \
} \
while (0)
RESOLVE_BOOLEAN_OPTION (COPY_SOURCE_P, copy_source_p);
RESOLVE_BOOLEAN_OPTION (RECORD_POSITIONS_P, record_positions_p);
RESOLVE_BOOLEAN_OPTION (CASE_INSENSITIVE_P, case_insensitive_p);
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);
#undef RESOLVE_BOOLEAN_OPTION
}
void void
scm_init_read () scm_init_read ()
{ {