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

read: Rename 'scm_t_read_opts' to 'scm_t_read_context'.

Browse source 
* libguile/read.c (scm_t_read_opts): Rename to 'scm_t_read_context'.
  (read_token, read_complete_token, flush_ws, maybe_annotate_source)
  (scm_read_sexp, scm_read_string_like_syntax, scm_read_string)
  (scm_read_r7rs_symbol, scm_read_number, scm_read_mixed_case_symbol)
  (scm_read_number_and_radix, scm_read_quote, scm_read_syntax)
  (scm_read_nil, scm_read_character, scm_read_keyword, scm_read_vector)
  (scm_read_array, scm_read_srfi4_vector, scm_read_bytevector)
  (scm_read_guile_bit_vector, scm_read_shebang, scm_read_sharp)
  (scm_read_commented_expression, scm_read_sharp_extension)
  (read_inner_expression, scm_read_expression, scm_read)
  (set_port_case_insensitive_p, set_port_square_brackets_p)
  (set_port_curly_infix_p): Adapt to renamed 'scm_t_read_opts' to
  'scm_t_read_context', and rename 'opts' to 'ctx'.
  (init_read_options): Rename to 'init_read_context'.
  (init_read_context): Renamed from 'init_read_options'.  Adapt to
  renamed 'scm_t_read_opts' to 'scm_t_read_context', and rename 'opts'
  to 'ctx'.
This commit is contained in:
Mark H Weaver 2014-02-02 01:48:35 -05:00
parent cfefef6bd9
commit f687871ece
1 changed files with 167 additions and 165 deletions
Download patch file Download diff file Expand all files Collapse all files

332
libguile/read.c
View file

@ -93,7 +93,7 @@ scm_t_option scm_read_opts[] =
{ 0, }, { 0, },
}; };
/* Internal read options structure. This is initialized by 'scm_read' /* Internal read context structure. This is initialized by 'scm_read'
from the global and per-port read options, and a pointer is passed from the global and per-port read options, and a pointer is passed
down to all helper functions. */ down to all helper functions. */
@ -104,7 +104,7 @@ enum t_keyword_style
KEYWORD_STYLE_POSTFIX KEYWORD_STYLE_POSTFIX
}; };
struct t_read_opts struct t_read_context
{ {
enum t_keyword_style keyword_style; enum t_keyword_style keyword_style;
unsigned int copy_source_p : 1; unsigned int copy_source_p : 1;
@ -118,7 +118,7 @@ struct t_read_opts
unsigned int r7rs_symbols_p : 1; unsigned int r7rs_symbols_p : 1;
}; };
typedef struct t_read_opts scm_t_read_opts; typedef struct t_read_context scm_t_read_context;
/* /*
@ -232,9 +232,9 @@ scm_i_read_hash_procedures_set_x (SCM value)
#define CHAR_IS_DELIMITER(c) \ #define CHAR_IS_DELIMITER(c) \
(CHAR_IS_R5RS_DELIMITER (c) \ (CHAR_IS_R5RS_DELIMITER (c) \
|| (((c) == ']' || (c) == '[') && (opts->square_brackets_p \ || (((c) == ']' || (c) == '[') && (ctx->square_brackets_p \
|| opts->curly_infix_p)) \ || ctx->curly_infix_p)) \
|| (((c) == '}' || (c) == '{') && opts->curly_infix_p)) || (((c) == '}' || (c) == '{') && ctx->curly_infix_p))
/* Exponent markers, as defined in section 7.1.1 of R5RS, ``Lexical /* Exponent markers, as defined in section 7.1.1 of R5RS, ``Lexical
Structure''. */ Structure''. */
@ -245,8 +245,9 @@ scm_i_read_hash_procedures_set_x (SCM value)
/* Read an SCSH block comment. */ /* Read an SCSH block comment. */
static SCM scm_read_scsh_block_comment (scm_t_wchar, SCM); static SCM scm_read_scsh_block_comment (scm_t_wchar, SCM);
static SCM scm_read_r6rs_block_comment (scm_t_wchar, SCM); static SCM scm_read_r6rs_block_comment (scm_t_wchar, SCM);
static SCM scm_read_commented_expression (scm_t_wchar, SCM, scm_t_read_opts *); static SCM scm_read_commented_expression (scm_t_wchar, SCM,
static SCM scm_read_shebang (scm_t_wchar, SCM, scm_t_read_opts *); scm_t_read_context *);
static SCM scm_read_shebang (scm_t_wchar, SCM, scm_t_read_context *);
static SCM scm_get_hash_procedure (int); static SCM scm_get_hash_procedure (int);
/* Read from PORT until a delimiter (e.g., a whitespace) is read. Put the /* Read from PORT until a delimiter (e.g., a whitespace) is read. Put the
@ -254,7 +255,7 @@ static SCM scm_get_hash_procedure (int);
fewer than BUF_SIZE bytes, non-zero otherwise. READ will be set the number of fewer than BUF_SIZE bytes, non-zero otherwise. READ will be set the number of
bytes actually read. */ bytes actually read. */
static int static int
read_token (SCM port, scm_t_read_opts *opts, read_token (SCM port, scm_t_read_context *ctx,
char *buf, size_t buf_size, size_t *read) char *buf, size_t buf_size, size_t *read)
{ {
*read = 0; *read = 0;
@ -285,7 +286,7 @@ read_token (SCM port, scm_t_read_opts *opts,
/* Like `read_token', but return either BUFFER, or a GC-allocated buffer /* Like `read_token', but return either BUFFER, or a GC-allocated buffer
if the token doesn't fit in BUFFER_SIZE bytes. */ if the token doesn't fit in BUFFER_SIZE bytes. */
static char * static char *
read_complete_token (SCM port, scm_t_read_opts *opts, read_complete_token (SCM port, scm_t_read_context *ctx,
char *buffer, size_t buffer_size, size_t *read) char *buffer, size_t buffer_size, size_t *read)
{ {
int overflow = 0; int overflow = 0;
@ -294,7 +295,7 @@ read_complete_token (SCM port, scm_t_read_opts *opts,
do do
{ {
overflow = read_token (port, opts, buffer, buffer_size, &bytes_read); overflow = read_token (port, ctx, buffer, buffer_size, &bytes_read);
if (bytes_read == 0) if (bytes_read == 0)
break; break;
if (overflow || overflow_size != 0) if (overflow || overflow_size != 0)
@ -331,7 +332,7 @@ read_complete_token (SCM port, scm_t_read_opts *opts,
/* Skip whitespace from PORT and return the first non-whitespace character /* Skip whitespace from PORT and return the first non-whitespace character
read. Raise an error on end-of-file. */ read. Raise an error on end-of-file. */
static int static int
flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr) flush_ws (SCM port, scm_t_read_context *ctx, const char *eoferr)
{ {
scm_t_wchar c; scm_t_wchar c;
while (1) while (1)
@ -368,10 +369,10 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr)
eoferr = "read_sharp"; eoferr = "read_sharp";
goto goteof; goto goteof;
case '!': case '!':
scm_read_shebang (c, port, opts); scm_read_shebang (c, port, ctx);
break; break;
case ';': case ';':
scm_read_commented_expression (c, port, opts); scm_read_commented_expression (c, port, ctx);
break; break;
case '|': case '|':
if (scm_is_false (scm_get_hash_procedure (c))) if (scm_is_false (scm_get_hash_procedure (c)))
@ -402,27 +403,27 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr)
/* Token readers. */ /* Token readers. */
static SCM scm_read_expression (SCM port, scm_t_read_opts *opts); static SCM scm_read_expression (SCM port, scm_t_read_context *ctx);
static SCM scm_read_sharp (int chr, SCM port, scm_t_read_opts *opts, static SCM scm_read_sharp (int chr, SCM port, scm_t_read_context *ctx,
long line, int column); long line, int column);
static SCM static SCM
maybe_annotate_source (SCM x, SCM port, scm_t_read_opts *opts, maybe_annotate_source (SCM x, SCM port, scm_t_read_context *ctx,
long line, int column) long line, int column)
{ {
if (opts->record_positions_p) if (ctx->record_positions_p)
scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port)); scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port));
return x; return x;
} }
static SCM static SCM
scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_context *ctx)
#define FUNC_NAME "scm_i_lreadparen" #define FUNC_NAME "scm_i_lreadparen"
{ {
int c; int c;
SCM tmp, tl, ans = SCM_EOL; SCM tmp, tl, ans = SCM_EOL;
const int curly_list_p = (chr == '{') && opts->curly_infix_p; const int curly_list_p = (chr == '{') && ctx->curly_infix_p;
const int terminating_char = ((chr == '{') ? '}' const int terminating_char = ((chr == '{') ? '}'
: ((chr == '[') ? ']' : ((chr == '[') ? ']'
: ')')); : ')'));
@ -431,20 +432,20 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
long line = SCM_LINUM (port); long line = SCM_LINUM (port);
int column = SCM_COL (port) - 1; int column = SCM_COL (port) - 1;
c = flush_ws (port, opts, FUNC_NAME); c = flush_ws (port, ctx, FUNC_NAME);
if (terminating_char == c) if (terminating_char == c)
return SCM_EOL; return SCM_EOL;
scm_ungetc (c, port); scm_ungetc (c, port);
tmp = scm_read_expression (port, opts); tmp = scm_read_expression (port, ctx);
/* Note that it is possible for scm_read_expression to return /* Note that it is possible for scm_read_expression to return
scm_sym_dot, but not as part of a dotted pair: as in #{.}#. So scm_sym_dot, but not as part of a dotted pair: as in #{.}#. So
check that it's a real dot by checking `c'. */ check that it's a real dot by checking `c'. */
if (c == '.' && scm_is_eq (scm_sym_dot, tmp)) if (c == '.' && scm_is_eq (scm_sym_dot, tmp))
{ {
ans = scm_read_expression (port, opts); ans = scm_read_expression (port, ctx);
if (terminating_char != (c = flush_ws (port, opts, FUNC_NAME))) if (terminating_char != (c = flush_ws (port, ctx, FUNC_NAME)))
scm_i_input_error (FUNC_NAME, port, "missing close paren", scm_i_input_error (FUNC_NAME, port, "missing close paren",
SCM_EOL); SCM_EOL);
return ans; return ans;
@ -453,25 +454,25 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
/* Build the head of the list structure. */ /* Build the head of the list structure. */
ans = tl = scm_cons (tmp, SCM_EOL); ans = tl = scm_cons (tmp, SCM_EOL);
while (terminating_char != (c = flush_ws (port, opts, FUNC_NAME))) while (terminating_char != (c = flush_ws (port, ctx, FUNC_NAME)))
{ {
SCM new_tail; SCM new_tail;
if (c == ')' || (c == ']' && opts->square_brackets_p) if (c == ')' || (c == ']' && ctx->square_brackets_p)
|| ((c == '}' || c == ']') && opts->curly_infix_p)) || ((c == '}' || c == ']') && ctx->curly_infix_p))
scm_i_input_error (FUNC_NAME, port, scm_i_input_error (FUNC_NAME, port,
"in pair: mismatched close paren: ~A", "in pair: mismatched close paren: ~A",
scm_list_1 (SCM_MAKE_CHAR (c))); scm_list_1 (SCM_MAKE_CHAR (c)));
scm_ungetc (c, port); scm_ungetc (c, port);
tmp = scm_read_expression (port, opts); tmp = scm_read_expression (port, ctx);
/* See above note about scm_sym_dot. */ /* See above note about scm_sym_dot. */
if (c == '.' && scm_is_eq (scm_sym_dot, tmp)) if (c == '.' && scm_is_eq (scm_sym_dot, tmp))
{ {
SCM_SETCDR (tl, scm_read_expression (port, opts)); SCM_SETCDR (tl, scm_read_expression (port, ctx));
c = flush_ws (port, opts, FUNC_NAME); c = flush_ws (port, ctx, FUNC_NAME);
if (terminating_char != c) if (terminating_char != c)
scm_i_input_error (FUNC_NAME, port, scm_i_input_error (FUNC_NAME, port,
"in pair: missing close paren", SCM_EOL); "in pair: missing close paren", SCM_EOL);
@ -536,7 +537,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
ans = scm_cons (sym_nfx, ans); ans = scm_cons (sym_nfx, ans);
} }
return maybe_annotate_source (ans, port, opts, line, column); return maybe_annotate_source (ans, port, ctx, line, column);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -595,7 +596,7 @@ skip_intraline_whitespace (SCM port)
by vertical lines, depending on the value of 'chr' ('"' or '|'). by vertical lines, depending on the value of 'chr' ('"' or '|').
Regardless, the result is always returned as a string. */ Regardless, the result is always returned as a string. */
static SCM static SCM
scm_read_string_like_syntax (int chr, SCM port, scm_t_read_opts *opts) scm_read_string_like_syntax (int chr, SCM port, scm_t_read_context *ctx)
#define FUNC_NAME "scm_lreadr" #define FUNC_NAME "scm_lreadr"
{ {
/* For strings smaller than C_STR, this function creates only one Scheme /* For strings smaller than C_STR, this function creates only one Scheme
@ -637,7 +638,7 @@ scm_read_string_like_syntax (int chr, SCM port, scm_t_read_opts *opts)
case '\\': case '\\':
break; break;
case '\n': case '\n':
if (opts->hungry_eol_escapes_p) if (ctx->hungry_eol_escapes_p)
skip_intraline_whitespace (port); skip_intraline_whitespace (port);
continue; continue;
case '0': case '0':
@ -665,19 +666,19 @@ scm_read_string_like_syntax (int chr, SCM port, scm_t_read_opts *opts)
c = '\010'; c = '\010';
break; break;
case 'x': case 'x':
if (opts->r6rs_escapes_p || chr == '|') if (ctx->r6rs_escapes_p || chr == '|')
SCM_READ_HEX_ESCAPE (10, ';'); SCM_READ_HEX_ESCAPE (10, ';');
else else
SCM_READ_HEX_ESCAPE (2, '\0'); SCM_READ_HEX_ESCAPE (2, '\0');
break; break;
case 'u': case 'u':
if (!opts->r6rs_escapes_p) if (!ctx->r6rs_escapes_p)
{ {
SCM_READ_HEX_ESCAPE (4, '\0'); SCM_READ_HEX_ESCAPE (4, '\0');
break; break;
} }
case 'U': case 'U':
if (!opts->r6rs_escapes_p) if (!ctx->r6rs_escapes_p)
{ {
SCM_READ_HEX_ESCAPE (6, '\0'); SCM_READ_HEX_ESCAPE (6, '\0');
break; break;
@ -706,24 +707,24 @@ scm_read_string_like_syntax (int chr, SCM port, scm_t_read_opts *opts)
str = scm_string_concatenate_reverse (str, SCM_UNDEFINED, SCM_UNDEFINED); str = scm_string_concatenate_reverse (str, SCM_UNDEFINED, SCM_UNDEFINED);
} }
return maybe_annotate_source (str, port, opts, line, column); return maybe_annotate_source (str, port, ctx, line, column);
} }
#undef FUNC_NAME #undef FUNC_NAME
static SCM static SCM
scm_read_string (int chr, SCM port, scm_t_read_opts *opts) scm_read_string (int chr, SCM port, scm_t_read_context *ctx)
{ {
return scm_read_string_like_syntax (chr, port, opts); return scm_read_string_like_syntax (chr, port, ctx);
} }
static SCM static SCM
scm_read_r7rs_symbol (int chr, SCM port, scm_t_read_opts *opts) scm_read_r7rs_symbol (int chr, SCM port, scm_t_read_context *ctx)
{ {
return scm_string_to_symbol (scm_read_string_like_syntax (chr, port, opts)); return scm_string_to_symbol (scm_read_string_like_syntax (chr, port, ctx));
} }
static SCM static SCM
scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_context *ctx)
{ {
SCM result, str = SCM_EOL; SCM result, str = SCM_EOL;
char local_buffer[READER_BUFFER_SIZE], *buffer; char local_buffer[READER_BUFFER_SIZE], *buffer;
@ -735,7 +736,7 @@ scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
int column = SCM_COL (port) - 1; int column = SCM_COL (port) - 1;
scm_ungetc (chr, port); scm_ungetc (chr, port);
buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer, buffer = read_complete_token (port, ctx, local_buffer, sizeof local_buffer,
&bytes_read); &bytes_read);
str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler); str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
@ -744,30 +745,30 @@ scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
if (scm_is_false (result)) if (scm_is_false (result))
{ {
/* Return a symbol instead of a number */ /* Return a symbol instead of a number */
if (opts->case_insensitive_p) if (ctx->case_insensitive_p)
str = scm_string_downcase_x (str); str = scm_string_downcase_x (str);
result = scm_string_to_symbol (str); result = scm_string_to_symbol (str);
} }
else if (SCM_NIMP (result)) else if (SCM_NIMP (result))
result = maybe_annotate_source (result, port, opts, line, column); result = maybe_annotate_source (result, port, ctx, line, column);
SCM_COL (port) += scm_i_string_length (str); SCM_COL (port) += scm_i_string_length (str);
return result; return result;
} }
static SCM static SCM
scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_context *ctx)
{ {
SCM result; SCM result;
int ends_with_colon = 0; int ends_with_colon = 0;
size_t bytes_read; size_t bytes_read;
int postfix = (opts->keyword_style == KEYWORD_STYLE_POSTFIX); int postfix = (ctx->keyword_style == KEYWORD_STYLE_POSTFIX);
char local_buffer[READER_BUFFER_SIZE], *buffer; char local_buffer[READER_BUFFER_SIZE], *buffer;
scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_port *pt = SCM_PTAB_ENTRY (port);
SCM str; SCM str;
scm_ungetc (chr, port); scm_ungetc (chr, port);
buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer, buffer = read_complete_token (port, ctx, local_buffer, sizeof local_buffer,
&bytes_read); &bytes_read);
if (bytes_read > 0) if (bytes_read > 0)
ends_with_colon = buffer[bytes_read - 1] == ':'; ends_with_colon = buffer[bytes_read - 1] == ':';
@ -777,7 +778,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
str = scm_from_stringn (buffer, bytes_read - 1, str = scm_from_stringn (buffer, bytes_read - 1,
pt->encoding, pt->ilseq_handler); pt->encoding, pt->ilseq_handler);
if (opts->case_insensitive_p) if (ctx->case_insensitive_p)
str = scm_string_downcase_x (str); str = scm_string_downcase_x (str);
result = scm_symbol_to_keyword (scm_string_to_symbol (str)); result = scm_symbol_to_keyword (scm_string_to_symbol (str));
} }
@ -786,7 +787,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
str = scm_from_stringn (buffer, bytes_read, str = scm_from_stringn (buffer, bytes_read,
pt->encoding, pt->ilseq_handler); pt->encoding, pt->ilseq_handler);
if (opts->case_insensitive_p) if (ctx->case_insensitive_p)
str = scm_string_downcase_x (str); str = scm_string_downcase_x (str);
result = scm_string_to_symbol (str); result = scm_string_to_symbol (str);
} }
@ -796,7 +797,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
} }
static SCM static SCM
scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_context *ctx)
#define FUNC_NAME "scm_lreadr" #define FUNC_NAME "scm_lreadr"
{ {
SCM result; SCM result;
@ -834,7 +835,7 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
radix = 10; radix = 10;
} }
buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer, buffer = read_complete_token (port, ctx, local_buffer, sizeof local_buffer,
&read); &read);
pt = SCM_PTAB_ENTRY (port); pt = SCM_PTAB_ENTRY (port);
@ -854,7 +855,7 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
#undef FUNC_NAME #undef FUNC_NAME
static SCM static SCM
scm_read_quote (int chr, SCM port, scm_t_read_opts *opts) scm_read_quote (int chr, SCM port, scm_t_read_context *ctx)
{ {
SCM p; SCM p;
long line = SCM_LINUM (port); long line = SCM_LINUM (port);
@ -891,8 +892,8 @@ scm_read_quote (int chr, SCM port, scm_t_read_opts *opts)
abort (); abort ();
} }
p = scm_cons2 (p, scm_read_expression (port, opts), SCM_EOL); p = scm_cons2 (p, scm_read_expression (port, ctx), SCM_EOL);
return maybe_annotate_source (p, port, opts, line, column); return maybe_annotate_source (p, port, ctx, line, column);
} }
SCM_SYMBOL (sym_syntax, "syntax"); SCM_SYMBOL (sym_syntax, "syntax");
@ -901,7 +902,7 @@ SCM_SYMBOL (sym_unsyntax, "unsyntax");
SCM_SYMBOL (sym_unsyntax_splicing, "unsyntax-splicing"); SCM_SYMBOL (sym_unsyntax_splicing, "unsyntax-splicing");
static SCM static SCM
scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts) scm_read_syntax (int chr, SCM port, scm_t_read_context *ctx)
{ {
SCM p; SCM p;
long line = SCM_LINUM (port); long line = SCM_LINUM (port);
@ -938,14 +939,14 @@ scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts)
abort (); abort ();
} }
p = scm_cons2 (p, scm_read_expression (port, opts), SCM_EOL); p = scm_cons2 (p, scm_read_expression (port, ctx), SCM_EOL);
return maybe_annotate_source (p, port, opts, line, column); return maybe_annotate_source (p, port, ctx, line, column);
} }
static SCM static SCM
scm_read_nil (int chr, SCM port, scm_t_read_opts *opts) scm_read_nil (int chr, SCM port, scm_t_read_context *ctx)
{ {
SCM id = scm_read_mixed_case_symbol (chr, port, opts); SCM id = scm_read_mixed_case_symbol (chr, port, ctx);
if (!scm_is_eq (id, sym_nil)) if (!scm_is_eq (id, sym_nil))
scm_i_input_error ("scm_read_nil", port, scm_i_input_error ("scm_read_nil", port,
@ -1030,7 +1031,7 @@ scm_read_boolean (int chr, SCM port)
} }
static SCM static SCM
scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_context *ctx)
#define FUNC_NAME "scm_lreadr" #define FUNC_NAME "scm_lreadr"
{ {
char buffer[READER_CHAR_NAME_MAX_SIZE]; char buffer[READER_CHAR_NAME_MAX_SIZE];
@ -1040,7 +1041,7 @@ scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
int overflow; int overflow;
scm_t_port *pt; scm_t_port *pt;
overflow = read_token (port, opts, buffer, READER_CHAR_NAME_MAX_SIZE, overflow = read_token (port, ctx, buffer, READER_CHAR_NAME_MAX_SIZE,
&bytes_read); &bytes_read);
if (overflow) if (overflow)
scm_i_input_error (FUNC_NAME, port, "character name too long", SCM_EOL); scm_i_input_error (FUNC_NAME, port, "character name too long", SCM_EOL);
@ -1137,7 +1138,7 @@ scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
#undef FUNC_NAME #undef FUNC_NAME
static SCM static SCM
scm_read_keyword (int chr, SCM port, scm_t_read_opts *opts) scm_read_keyword (int chr, SCM port, scm_t_read_context *ctx)
{ {
SCM symbol; SCM symbol;
@ -1146,7 +1147,7 @@ scm_read_keyword (int chr, SCM port, scm_t_read_opts *opts)
to adapt to the delimiters currently valid of symbols. to adapt to the delimiters currently valid of symbols.
XXX: This implementation allows sloppy syntaxes like `#: key'. */ XXX: This implementation allows sloppy syntaxes like `#: key'. */
symbol = scm_read_expression (port, opts); symbol = scm_read_expression (port, ctx);
if (!scm_is_symbol (symbol)) if (!scm_is_symbol (symbol))
scm_i_input_error ("scm_read_keyword", port, scm_i_input_error ("scm_read_keyword", port,
"keyword prefix `~a' not followed by a symbol: ~s", "keyword prefix `~a' not followed by a symbol: ~s",
@ -1156,15 +1157,15 @@ scm_read_keyword (int chr, SCM port, scm_t_read_opts *opts)
} }
static SCM static SCM
scm_read_vector (int chr, SCM port, scm_t_read_opts *opts, scm_read_vector (int chr, SCM port, scm_t_read_context *ctx,
long line, int column) long line, int column)
{ {
/* Note: We call `scm_read_sexp ()' rather than READER here in order to /* Note: We call `scm_read_sexp ()' rather than READER here in order to
guarantee that it's going to do what we want. After all, this is an guarantee that it's going to do what we want. After all, this is an
implementation detail of `scm_read_vector ()', not a desirable implementation detail of `scm_read_vector ()', not a desirable
property. */ property. */
return maybe_annotate_source (scm_vector (scm_read_sexp (chr, port, opts)), return maybe_annotate_source (scm_vector (scm_read_sexp (chr, port, ctx)),
port, opts, line, column); port, ctx, line, column);
} }
/* Helper used by scm_read_array */ /* Helper used by scm_read_array */
@ -1202,7 +1203,8 @@ read_decimal_integer (SCM port, int c, ssize_t *resp)
C is the first character read after the '#'. */ C is the first character read after the '#'. */
static SCM static SCM
scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column) scm_read_array (int c, SCM port, scm_t_read_context *ctx,
long line, int column)
{ {
ssize_t rank; ssize_t rank;
scm_t_wchar tag_buf[8]; scm_t_wchar tag_buf[8];
@ -1214,7 +1216,7 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
the array code can not deal with zero-length dimensions yet, and the array code can not deal with zero-length dimensions yet, and
we want to allow zero-length vectors, of course. */ we want to allow zero-length vectors, of course. */
if (c == '(') if (c == '(')
return scm_read_vector (c, port, opts, line, column); return scm_read_vector (c, port, ctx, line, column);
/* Disambiguate between '#f' and uniform floating point vectors. */ /* Disambiguate between '#f' and uniform floating point vectors. */
if (c == 'f') if (c == 'f')
@ -1301,7 +1303,7 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
scm_i_input_error (NULL, port, scm_i_input_error (NULL, port,
"missing '(' in vector or array literal", "missing '(' in vector or array literal",
SCM_EOL); SCM_EOL);
elements = scm_read_sexp (c, port, opts); elements = scm_read_sexp (c, port, ctx);
if (scm_is_false (shape)) if (scm_is_false (shape))
shape = scm_from_ssize_t (rank); shape = scm_from_ssize_t (rank);
@ -1328,18 +1330,18 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
/* Construct array, annotate with source location, and return. */ /* Construct array, annotate with source location, and return. */
array = scm_list_to_typed_array (tag, shape, elements); array = scm_list_to_typed_array (tag, shape, elements);
return maybe_annotate_source (array, port, opts, line, column); return maybe_annotate_source (array, port, ctx, line, column);
} }
static SCM static SCM
scm_read_srfi4_vector (int chr, SCM port, scm_t_read_opts *opts, scm_read_srfi4_vector (int chr, SCM port, scm_t_read_context *ctx,
long line, int column) long line, int column)
{ {
return scm_read_array (chr, port, opts, line, column); return scm_read_array (chr, port, ctx, line, column);
} }
static SCM static SCM
scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts, scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_context *ctx,
long line, int column) long line, int column)
{ {
chr = scm_getc (port); chr = scm_getc (port);
@ -1355,8 +1357,8 @@ scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
goto syntax; goto syntax;
return maybe_annotate_source return maybe_annotate_source
(scm_u8_list_to_bytevector (scm_read_sexp (chr, port, opts)), (scm_u8_list_to_bytevector (scm_read_sexp (chr, port, ctx)),
port, opts, line, column); port, ctx, line, column);
syntax: syntax:
scm_i_input_error ("read_bytevector", port, scm_i_input_error ("read_bytevector", port,
@ -1366,7 +1368,7 @@ scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
} }
static SCM static SCM
scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts, scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, scm_t_read_context *ctx,
long line, int column) long line, int column)
{ {
/* Read the `#*10101'-style read syntax for bit vectors in Guile. This is /* Read the `#*10101'-style read syntax for bit vectors in Guile. This is
@ -1385,7 +1387,7 @@ scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
return maybe_annotate_source return maybe_annotate_source
(scm_bitvector (scm_reverse_x (s_bits, SCM_EOL)), (scm_bitvector (scm_reverse_x (s_bits, SCM_EOL)),
port, opts, line, column); port, ctx, line, column);
} }
static SCM static SCM
@ -1412,15 +1414,15 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port)
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
static void set_port_case_insensitive_p (SCM port, scm_t_read_opts *opts, static void set_port_case_insensitive_p (SCM port, scm_t_read_context *ctx,
int value); int value);
static void set_port_square_brackets_p (SCM port, scm_t_read_opts *opts, static void set_port_square_brackets_p (SCM port, scm_t_read_context *ctx,
int value); int value);
static void set_port_curly_infix_p (SCM port, scm_t_read_opts *opts, static void set_port_curly_infix_p (SCM port, scm_t_read_context *ctx,
int value); int value);
static SCM static SCM
scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_context *ctx)
{ {
char name[READER_DIRECTIVE_NAME_MAX_SIZE + 1]; char name[READER_DIRECTIVE_NAME_MAX_SIZE + 1];
int c; int c;
@ -1441,15 +1443,15 @@ scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
if (0 == strcmp ("r6rs", name)) if (0 == strcmp ("r6rs", name))
; /* Silently ignore */ ; /* Silently ignore */
else if (0 == strcmp ("fold-case", name)) else if (0 == strcmp ("fold-case", name))
set_port_case_insensitive_p (port, opts, 1); set_port_case_insensitive_p (port, ctx, 1);
else if (0 == strcmp ("no-fold-case", name)) else if (0 == strcmp ("no-fold-case", name))
set_port_case_insensitive_p (port, opts, 0); set_port_case_insensitive_p (port, ctx, 0);
else if (0 == strcmp ("curly-infix", name)) else if (0 == strcmp ("curly-infix", name))
set_port_curly_infix_p (port, opts, 1); set_port_curly_infix_p (port, ctx, 1);
else if (0 == strcmp ("curly-infix-and-bracket-lists", name)) else if (0 == strcmp ("curly-infix-and-bracket-lists", name))
{ {
set_port_curly_infix_p (port, opts, 1); set_port_curly_infix_p (port, ctx, 1);
set_port_square_brackets_p (port, opts, 0); set_port_square_brackets_p (port, ctx, 0);
} }
else else
break; break;
@ -1507,16 +1509,16 @@ scm_read_r6rs_block_comment (scm_t_wchar chr, SCM port)
static SCM static SCM
scm_read_commented_expression (scm_t_wchar chr, SCM port, scm_read_commented_expression (scm_t_wchar chr, SCM port,
scm_t_read_opts *opts) scm_t_read_context *ctx)
{ {
scm_t_wchar c; scm_t_wchar c;
c = flush_ws (port, opts, (char *) NULL); c = flush_ws (port, ctx, (char *) NULL);
if (EOF == c) if (EOF == c)
scm_i_input_error ("read_commented_expression", port, scm_i_input_error ("read_commented_expression", port,
"no expression after #; comment", SCM_EOL); "no expression after #; comment", SCM_EOL);
scm_ungetc (c, port); scm_ungetc (c, port);
scm_read_expression (port, opts); scm_read_expression (port, ctx);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -1618,7 +1620,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port)
/* Top-level token readers, i.e., dispatchers. */ /* Top-level token readers, i.e., dispatchers. */
static SCM static SCM
scm_read_sharp_extension (int chr, SCM port, scm_t_read_opts *opts) scm_read_sharp_extension (int chr, SCM port, scm_t_read_context *ctx)
{ {
SCM proc; SCM proc;
@ -1631,7 +1633,7 @@ scm_read_sharp_extension (int chr, SCM port, scm_t_read_opts *opts)
got = scm_call_2 (proc, SCM_MAKE_CHAR (chr), port); got = scm_call_2 (proc, SCM_MAKE_CHAR (chr), port);
if (opts->record_positions_p && SCM_NIMP (got) if (ctx->record_positions_p && SCM_NIMP (got)
&& !scm_i_has_source_properties (got)) && !scm_i_has_source_properties (got))
scm_i_set_source_properties_x (got, line, column, SCM_FILENAME (port)); scm_i_set_source_properties_x (got, line, column, SCM_FILENAME (port));
@ -1644,7 +1646,7 @@ scm_read_sharp_extension (int chr, SCM port, scm_t_read_opts *opts)
/* The reader for the sharp `#' character. It basically dispatches reads /* The reader for the sharp `#' character. It basically dispatches reads
among the above token readers. */ among the above token readers. */
static SCM static SCM
scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts, scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_context *ctx,
long line, int column) long line, int column)
#define FUNC_NAME "scm_lreadr" #define FUNC_NAME "scm_lreadr"
{ {
@ -1652,32 +1654,32 @@ scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
chr = scm_getc (port); chr = scm_getc (port);
result = scm_read_sharp_extension (chr, port, opts); result = scm_read_sharp_extension (chr, port, ctx);
if (!scm_is_eq (result, SCM_UNSPECIFIED)) if (!scm_is_eq (result, SCM_UNSPECIFIED))
return result; return result;
switch (chr) switch (chr)
{ {
case '\\': case '\\':
return (scm_read_character (chr, port, opts)); return (scm_read_character (chr, port, ctx));
case '(': case '(':
return (scm_read_vector (chr, port, opts, line, column)); return (scm_read_vector (chr, port, ctx, line, column));
case 's': case 's':
case 'u': case 'u':
case 'f': case 'f':
case 'c': case 'c':
/* This one may return either a boolean or an SRFI-4 vector. */ /* This one may return either a boolean or an SRFI-4 vector. */
return (scm_read_srfi4_vector (chr, port, opts, line, column)); return (scm_read_srfi4_vector (chr, port, ctx, line, column));
case 'v': case 'v':
return (scm_read_bytevector (chr, port, opts, line, column)); return (scm_read_bytevector (chr, port, ctx, line, column));
case '*': case '*':
return (scm_read_guile_bit_vector (chr, port, opts, line, column)); return (scm_read_guile_bit_vector (chr, port, ctx, line, column));
case 't': case 't':
case 'T': case 'T':
case 'F': case 'F':
return (scm_read_boolean (chr, port)); return (scm_read_boolean (chr, port));
case ':': case ':':
return (scm_read_keyword (chr, port, opts)); return (scm_read_keyword (chr, port, ctx));
case '0': case '1': case '2': case '3': case '4': case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': case '5': case '6': case '7': case '8': case '9':
case '@': case '@':
@ -1688,7 +1690,7 @@ scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
case 'h': case 'h':
case 'l': case 'l':
#endif #endif
return (scm_read_array (chr, port, opts, line, column)); return (scm_read_array (chr, port, ctx, line, column));
case 'i': case 'i':
case 'e': case 'e':
@ -1700,7 +1702,7 @@ scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
if (next_c != EOF) if (next_c != EOF)
scm_ungetc (next_c, port); scm_ungetc (next_c, port);
if (next_c == '(') if (next_c == '(')
return scm_read_array (chr, port, opts, line, column); return scm_read_array (chr, port, ctx, line, column);
/* Fall through. */ /* Fall through. */
} }
#endif #endif
@ -1714,21 +1716,21 @@ scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
case 'X': case 'X':
case 'I': case 'I':
case 'E': case 'E':
return (scm_read_number_and_radix (chr, port, opts)); return (scm_read_number_and_radix (chr, port, ctx));
case '{': case '{':
return (scm_read_extended_symbol (chr, port)); return (scm_read_extended_symbol (chr, port));
case '!': case '!':
return (scm_read_shebang (chr, port, opts)); return (scm_read_shebang (chr, port, ctx));
case ';': case ';':
return (scm_read_commented_expression (chr, port, opts)); return (scm_read_commented_expression (chr, port, ctx));
case '`': case '`':
case '\'': case '\'':
case ',': case ',':
return (scm_read_syntax (chr, port, opts)); return (scm_read_syntax (chr, port, ctx));
case 'n': case 'n':
return (scm_read_nil (chr, port, opts)); return (scm_read_nil (chr, port, ctx));
default: default:
result = scm_read_sharp_extension (chr, port, opts); result = scm_read_sharp_extension (chr, port, ctx);
if (scm_is_eq (result, SCM_UNSPECIFIED)) if (scm_is_eq (result, SCM_UNSPECIFIED))
{ {
/* To remain compatible with 1.8 and earlier, the following /* To remain compatible with 1.8 and earlier, the following
@ -1752,7 +1754,7 @@ scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
#undef FUNC_NAME #undef FUNC_NAME
static SCM static SCM
read_inner_expression (SCM port, scm_t_read_opts *opts) read_inner_expression (SCM port, scm_t_read_context *ctx)
#define FUNC_NAME "read_inner_expression" #define FUNC_NAME "read_inner_expression"
{ {
while (1) while (1)
@ -1770,27 +1772,27 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
(void) scm_read_semicolon_comment (chr, port); (void) scm_read_semicolon_comment (chr, port);
break; break;
case '{': case '{':
if (opts->curly_infix_p) if (ctx->curly_infix_p)
{ {
if (opts->neoteric_p) if (ctx->neoteric_p)
return scm_read_sexp (chr, port, opts); return scm_read_sexp (chr, port, ctx);
else else
{ {
SCM expr; SCM expr;
/* Enable neoteric expressions within curly braces */ /* Enable neoteric expressions within curly braces */
opts->neoteric_p = 1; ctx->neoteric_p = 1;
expr = scm_read_sexp (chr, port, opts); expr = scm_read_sexp (chr, port, ctx);
opts->neoteric_p = 0; ctx->neoteric_p = 0;
return expr; return expr;
} }
} }
else else
return scm_read_mixed_case_symbol (chr, port, opts); return scm_read_mixed_case_symbol (chr, port, ctx);
case '[': case '[':
if (opts->square_brackets_p) if (ctx->square_brackets_p)
return scm_read_sexp (chr, port, opts); return scm_read_sexp (chr, port, ctx);
else if (opts->curly_infix_p) else if (ctx->curly_infix_p)
{ {
/* The syntax of neoteric expressions requires that '[' be /* The syntax of neoteric expressions requires that '[' be
a delimiter when curly-infix is enabled, so it cannot a delimiter when curly-infix is enabled, so it cannot
@ -1800,29 +1802,29 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
long line = SCM_LINUM (port); long line = SCM_LINUM (port);
int column = SCM_COL (port) - 1; int column = SCM_COL (port) - 1;
return maybe_annotate_source return maybe_annotate_source
(scm_cons (sym_bracket_list, scm_read_sexp (chr, port, opts)), (scm_cons (sym_bracket_list, scm_read_sexp (chr, port, ctx)),
port, opts, line, column); port, ctx, line, column);
} }
else else
return scm_read_mixed_case_symbol (chr, port, opts); return scm_read_mixed_case_symbol (chr, port, ctx);
case '(': case '(':
return (scm_read_sexp (chr, port, opts)); return (scm_read_sexp (chr, port, ctx));
case '"': case '"':
return (scm_read_string (chr, port, opts)); return (scm_read_string (chr, port, ctx));
case '|': case '|':
if (opts->r7rs_symbols_p) if (ctx->r7rs_symbols_p)
return scm_read_r7rs_symbol (chr, port, opts); return scm_read_r7rs_symbol (chr, port, ctx);
else else
return scm_read_mixed_case_symbol (chr, port, opts); return scm_read_mixed_case_symbol (chr, port, ctx);
case '\'': case '\'':
case '`': case '`':
case ',': case ',':
return (scm_read_quote (chr, port, opts)); return (scm_read_quote (chr, port, ctx));
case '#': case '#':
{ {
long line = SCM_LINUM (port); long line = SCM_LINUM (port);
int column = SCM_COL (port) - 1; int column = SCM_COL (port) - 1;
SCM result = scm_read_sharp (chr, port, opts, line, column); SCM result = scm_read_sharp (chr, port, ctx, line, column);
if (scm_is_eq (result, SCM_UNSPECIFIED)) if (scm_is_eq (result, SCM_UNSPECIFIED))
/* We read a comment or some such. */ /* We read a comment or some such. */
break; break;
@ -1833,28 +1835,28 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
scm_i_input_error (FUNC_NAME, port, "unexpected \")\"", SCM_EOL); scm_i_input_error (FUNC_NAME, port, "unexpected \")\"", SCM_EOL);
break; break;
case '}': case '}':
if (opts->curly_infix_p) if (ctx->curly_infix_p)
scm_i_input_error (FUNC_NAME, port, "unexpected \"}\"", SCM_EOL); scm_i_input_error (FUNC_NAME, port, "unexpected \"}\"", SCM_EOL);
else else
return scm_read_mixed_case_symbol (chr, port, opts); return scm_read_mixed_case_symbol (chr, port, ctx);
case ']': case ']':
if (opts->square_brackets_p) if (ctx->square_brackets_p)
scm_i_input_error (FUNC_NAME, port, "unexpected \"]\"", SCM_EOL); scm_i_input_error (FUNC_NAME, port, "unexpected \"]\"", SCM_EOL);
/* otherwise fall through */ /* otherwise fall through */
case EOF: case EOF:
return SCM_EOF_VAL; return SCM_EOF_VAL;
case ':': case ':':
if (opts->keyword_style == KEYWORD_STYLE_PREFIX) if (ctx->keyword_style == KEYWORD_STYLE_PREFIX)
return scm_symbol_to_keyword (scm_read_expression (port, opts)); return scm_symbol_to_keyword (scm_read_expression (port, ctx));
/* Fall through. */ /* Fall through. */
default: default:
{ {
if (((chr >= '0') && (chr <= '9')) if (((chr >= '0') && (chr <= '9'))
|| (strchr ("+-.", chr))) || (strchr ("+-.", chr)))
return (scm_read_number (chr, port, opts)); return (scm_read_number (chr, port, ctx));
else else
return (scm_read_mixed_case_symbol (chr, port, opts)); return (scm_read_mixed_case_symbol (chr, port, ctx));
} }
} }
} }
@ -1862,18 +1864,18 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
#undef FUNC_NAME #undef FUNC_NAME
static SCM static SCM
scm_read_expression (SCM port, scm_t_read_opts *opts) scm_read_expression (SCM port, scm_t_read_context *ctx)
#define FUNC_NAME "scm_read_expression" #define FUNC_NAME "scm_read_expression"
{ {
if (!opts->neoteric_p) if (!ctx->neoteric_p)
return read_inner_expression (port, opts); return read_inner_expression (port, ctx);
else else
{ {
long line = 0; long line = 0;
int column = 0; int column = 0;
SCM expr; SCM expr;
if (opts->record_positions_p) if (ctx->record_positions_p)
{ {
/* We need to get the position of the first non-whitespace /* We need to get the position of the first non-whitespace
character in order to correctly annotate neoteric character in order to correctly annotate neoteric
@ -1881,7 +1883,7 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
first call to 'read_inner_expression' reads the 'f' (which first call to 'read_inner_expression' reads the 'f' (which
cannot be annotated), and then we later read the '(x)' and cannot be annotated), and then we later read the '(x)' and
use it to construct the new list (f x). */ use it to construct the new list (f x). */
int c = flush_ws (port, opts, (char *) NULL); int c = flush_ws (port, ctx, (char *) NULL);
if (c == EOF) if (c == EOF)
return SCM_EOF_VAL; return SCM_EOF_VAL;
scm_ungetc (c, port); scm_ungetc (c, port);
@ -1889,7 +1891,7 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
column = SCM_COL (port); column = SCM_COL (port);
} }
expr = read_inner_expression (port, opts); expr = read_inner_expression (port, ctx);
/* 'expr' is the first component of the neoteric expression. Now /* 'expr' is the first component of the neoteric expression. Now
we loop, and as long as the next character is '(', '[', or '{', we loop, and as long as the next character is '(', '[', or '{',
@ -1901,15 +1903,15 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
if (chr == '(') if (chr == '(')
/* e(...) => (e ...) */ /* e(...) => (e ...) */
expr = scm_cons (expr, scm_read_sexp (chr, port, opts)); expr = scm_cons (expr, scm_read_sexp (chr, port, ctx));
else if (chr == '[') else if (chr == '[')
/* e[...] => ($bracket-apply$ e ...) */ /* e[...] => ($bracket-apply$ e ...) */
expr = scm_cons (sym_bracket_apply, expr = scm_cons (sym_bracket_apply,
scm_cons (expr, scm_cons (expr,
scm_read_sexp (chr, port, opts))); scm_read_sexp (chr, port, ctx)));
else if (chr == '{') else if (chr == '{')
{ {
SCM arg = scm_read_sexp (chr, port, opts); SCM arg = scm_read_sexp (chr, port, ctx);
if (scm_is_null (arg)) if (scm_is_null (arg))
expr = scm_list_1 (expr); /* e{} => (e) */ expr = scm_list_1 (expr); /* e{} => (e) */
@ -1922,7 +1924,7 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
scm_ungetc (chr, port); scm_ungetc (chr, port);
break; break;
} }
maybe_annotate_source (expr, port, opts, line, column); maybe_annotate_source (expr, port, ctx, line, column);
} }
return expr; return expr;
} }
@ -1932,7 +1934,7 @@ 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); static void init_read_context (SCM port, scm_t_read_context *ctx);
SCM_DEFINE (scm_read, "read", 0, 1, 0, SCM_DEFINE (scm_read, "read", 0, 1, 0,
(SCM port), (SCM port),
@ -1941,21 +1943,21 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
"Any whitespace before the next token is discarded.") "Any whitespace before the next token is discarded.")
#define FUNC_NAME s_scm_read #define FUNC_NAME s_scm_read
{ {
scm_t_read_opts opts; scm_t_read_context ctx;
int c; int c;
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_current_input_port (); port = scm_current_input_port ();
SCM_VALIDATE_OPINPORT (1, port); SCM_VALIDATE_OPINPORT (1, port);
init_read_options (port, &opts); init_read_context (port, &ctx);
c = flush_ws (port, &opts, (char *) NULL); c = flush_ws (port, &ctx, (char *) NULL);
if (EOF == c) if (EOF == c)
return SCM_EOF_VAL; return SCM_EOF_VAL;
scm_ungetc (c, port); scm_ungetc (c, port);
return (scm_read_expression (port, &opts)); return (scm_read_expression (port, &ctx));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -2275,37 +2277,37 @@ 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); scm_i_set_port_property_x (port, sym_port_read_options, scm_read_options);
} }
/* Set OPTS and PORT's case-insensitivity according to VALUE. */ /* Set CTX and PORT's case-insensitivity according to VALUE. */
static void static void
set_port_case_insensitive_p (SCM port, scm_t_read_opts *opts, int value) set_port_case_insensitive_p (SCM port, scm_t_read_context *ctx, int value)
{ {
value = !!value; value = !!value;
opts->case_insensitive_p = value; ctx->case_insensitive_p = value;
set_port_read_option (port, READ_OPTION_CASE_INSENSITIVE_P, value); set_port_read_option (port, READ_OPTION_CASE_INSENSITIVE_P, value);
} }
/* Set OPTS and PORT's square_brackets_p option according to VALUE. */ /* Set CTX and PORT's square_brackets_p option according to VALUE. */
static void static void
set_port_square_brackets_p (SCM port, scm_t_read_opts *opts, int value) set_port_square_brackets_p (SCM port, scm_t_read_context *ctx, int value)
{ {
value = !!value; value = !!value;
opts->square_brackets_p = value; ctx->square_brackets_p = value;
set_port_read_option (port, READ_OPTION_SQUARE_BRACKETS_P, value); set_port_read_option (port, READ_OPTION_SQUARE_BRACKETS_P, value);
} }
/* Set OPTS and PORT's curly_infix_p option according to VALUE. */ /* Set CTX and PORT's curly_infix_p option according to VALUE. */
static void static void
set_port_curly_infix_p (SCM port, scm_t_read_opts *opts, int value) set_port_curly_infix_p (SCM port, scm_t_read_context *ctx, int value)
{ {
value = !!value; value = !!value;
opts->curly_infix_p = value; ctx->curly_infix_p = value;
set_port_read_option (port, READ_OPTION_CURLY_INFIX_P, value); set_port_read_option (port, READ_OPTION_CURLY_INFIX_P, value);
} }
/* Initialize OPTS based on PORT's read options and the global read /* Initialize CTX based on PORT's read options and the global read
options. */ options. */
static void static void
init_read_options (SCM port, scm_t_read_opts *opts) init_read_context (SCM port, scm_t_read_context *ctx)
{ {
SCM val, scm_read_options; SCM val, scm_read_options;
unsigned int read_options, x; unsigned int read_options, x;
@ -2328,7 +2330,7 @@ init_read_options (SCM port, scm_t_read_opts *opts)
else else
x = KEYWORD_STYLE_HASH_PREFIX; x = KEYWORD_STYLE_HASH_PREFIX;
} }
opts->keyword_style = x; ctx->keyword_style = x;
#define RESOLVE_BOOLEAN_OPTION(NAME, name) \ #define RESOLVE_BOOLEAN_OPTION(NAME, name) \
do \ do \
@ -2336,7 +2338,7 @@ init_read_options (SCM port, scm_t_read_opts *opts)
x = READ_OPTION_MASK & (read_options >> READ_OPTION_ ## NAME); \ x = READ_OPTION_MASK & (read_options >> READ_OPTION_ ## NAME); \
if (x == READ_OPTION_INHERIT) \ if (x == READ_OPTION_INHERIT) \
x = !!SCM_ ## NAME; \ x = !!SCM_ ## NAME; \
opts->name = x; \ ctx->name = x; \
} \ } \
while (0) while (0)
@ -2351,7 +2353,7 @@ init_read_options (SCM port, scm_t_read_opts *opts)
#undef RESOLVE_BOOLEAN_OPTION #undef RESOLVE_BOOLEAN_OPTION
opts->neoteric_p = 0; ctx->neoteric_p = 0;
} }
void void