mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-15 09:20:23 -07:00
Code Issues Projects Releases Packages Wiki Activity

reader: turn separate parameters into flags in low-level read

Browse source 
Instead of passing parameters as values, we make a bitfield:

ECL_READ_LIST_DOT, ECL_READ_RETURN_IGNORABLE, ECL_READ_SUPPRESS,
ECL_READ_ESCAPE_FIST;

this way we don't rely on a dynamic variable in a low-level function.
This commit is contained in:
Daniel Kochmański 2026-03-05 12:49:22 +01:00
parent 83aa9b8df4
commit 27fb51b98f
6 changed files with 28 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

17
src/c/read.d
View file

@ -123,7 +123,8 @@ cl_object
ecl_read_object(cl_object in)
{
cl_object rtbl = ecl_current_readtable();
return ecl_read_object_with_delimiter(rtbl, in, EOF, 0);
int flags = read_suppress ? ECL_READ_SUPPRESS : 0;
return ecl_read_object_with_delimiter(rtbl, in, EOF, flags);
}
cl_object
@ -132,9 +133,11 @@ si_read_object_or_ignore(cl_object in, cl_object eof)
cl_object x;
const cl_env_ptr env = ecl_process_env();
cl_object rtbl = ecl_current_readtable();
int flags = ECL_READ_RETURN_IGNORABLE;
if (read_suppress) flags |= ECL_READ_SUPPRESS;
ecl_bds_bind(env, @'si::*sharp-eq-context*', ECL_NIL);
ecl_bds_bind(env, @'si::*backq-level*', ecl_make_fixnum(0));
x = ecl_read_object_with_delimiter(rtbl, in, EOF, ECL_READ_RETURN_IGNORABLE);
x = ecl_read_object_with_delimiter(rtbl, in, EOF, flags);
if (x == OBJNULL) {
env->nvalues = 1;
x = eof;
@ -414,11 +417,13 @@ ecl_read_delimited_list(int d, cl_object in, bool proper_list)
{
int after_dot = 0;
bool suppress = read_suppress;
int flags = ECL_READ_LIST_DOT;
if (suppress) flags |= ECL_READ_SUPPRESS;
cl_object x, y = ECL_NIL;
cl_object *p = &y;
cl_object rtbl = ecl_current_readtable();
do {
x = ecl_read_object_with_delimiter(rtbl, in, d, ECL_READ_LIST_DOT);
x = ecl_read_object_with_delimiter(rtbl, in, d, flags);
if (x == OBJNULL) {
/* End of the list. */
unlikely_if (after_dot == 1) {
@ -653,8 +658,9 @@ si_read_object(cl_object strm, cl_object delimiter)
{
cl_env_ptr the_env = ecl_process_env();
int ch = Null(delimiter) ? 0 : ecl_char_code(delimiter);
int flags = read_suppress ? ECL_READ_SUPPRESS : 0;
cl_object rtbl = ecl_current_readtable();
cl_object object = ecl_read_object_with_delimiter(rtbl, strm, ch, 0);
cl_object object = ecl_read_object_with_delimiter(rtbl, strm, ch, flags);
ecl_return1(the_env, object);
}
@ -663,7 +669,8 @@ si_read_token(cl_object strm)
{
cl_env_ptr the_env = ecl_process_env();
cl_object rtbl = ecl_current_readtable();
cl_object object = ecl_read_token(rtbl, strm, 0);
int flags = read_suppress ? ECL_READ_SUPPRESS : 0;
cl_object object = ecl_read_token(rtbl, strm, flags);
ecl_return1(the_env, object);
}

14
src/c/reader.d
View file

@ -26,8 +26,6 @@
#include <ecl/ecl-inl.h>
#include <ecl/bytecodes.h>
#define read_suppress (ecl_symbol_value(@'*read-suppress*') != ECL_NIL)
static cl_object
ecl_make_token()
{
@ -89,7 +87,6 @@ static void
invert_buffer_case(cl_object o, int sign)
{
int c;
cl_fixnum i;
loop_across_token(index, limit, string, o) {
c = TOKEN_STRING_CHAR(string, index);
if (ecl_upper_case_p(c) && (sign < 0)) {
@ -151,7 +148,7 @@ ecl_dispatch_reader_fun(cl_object in, cl_object dc)
}
cl_object
ecl_read_token(cl_object rtbl, cl_object in, bool escape_first_p)
ecl_read_token(cl_object rtbl, cl_object in, int flags)
{
int c;
cl_object token, string, escape;
@ -161,7 +158,8 @@ ecl_read_token(cl_object rtbl, cl_object in, bool escape_first_p)
enum ecl_readtable_case read_case = rtbl->readtable.read_case;
cl_fixnum upcase; /* # uppercase characters - # downcase characters */
cl_fixnum count; /* number of unescaped characters */
bool suppress = read_suppress;
bool suppress = flags & ECL_READ_SUPPRESS;
bool escape_first_p = flags & ECL_READ_ESCAPE_FIRST;
upcase = count = length = 0;
@ -255,7 +253,7 @@ ecl_read_object_with_delimiter(cl_object rtbl, cl_object in, int delimiter, int
int c;
enum ecl_chattrib a;
cl_env_ptr the_env = ecl_process_env();
bool suppress = read_suppress;
bool suppress = flags & ECL_READ_SUPPRESS;
BEGIN:
do {
c = ecl_read_char(in);
@ -281,7 +279,7 @@ ecl_read_object_with_delimiter(cl_object rtbl, cl_object in, int delimiter, int
o = _ecl_funcall3(x, in, ECL_CODE_CHAR(c));
}
if (the_env->nvalues == 0) {
if (flags == ECL_READ_RETURN_IGNORABLE)
if (flags & ECL_READ_RETURN_IGNORABLE)
return ECL_NIL;
goto BEGIN;
}
@ -292,7 +290,7 @@ ecl_read_object_with_delimiter(cl_object rtbl, cl_object in, int delimiter, int
return o;
}
ecl_unread_char(c, in);
token = ecl_read_token(rtbl, in, 0);
token = ecl_read_token(rtbl, in, flags);
if (suppress) {
x = ECL_NIL;
} else {

2
src/c/reader/parse_token.d
View file

@ -75,7 +75,7 @@ ecl_parse_token(cl_object token, cl_object in, int flags)
/* The case in which the buffer is full of dots has to be especial cased. */
if (length == 1 && TOKEN_STRING_CHAR_CMP(string, 0, '.')) {
if (flags == ECL_READ_LIST_DOT) {
if (flags & ECL_READ_LIST_DOT) {
x = @'si::.';
goto OUTPUT;
} else {

6
src/c/reader/rtab_cl.d
View file

@ -216,16 +216,18 @@ sharp_backslash_reader(cl_object in, cl_object c, cl_object d)
cl_object token, string;
cl_object rtbl = ecl_current_readtable();
bool suppress = read_suppress;
int flags = ECL_READ_ESCAPE_FIRST;
if (d != ECL_NIL && !suppress) {
unlikely_if (!ECL_FIXNUMP(d) || d != ecl_make_fixnum(0)) {
FEreader_error("~S is an illegal CHAR-FONT.", in, 1, d);
}
}
if(suppress) {
ecl_read_token(rtbl, in, 1);
flags |= ECL_READ_SUPPRESS;
ecl_read_token(rtbl, in, flags);
return ECL_NIL;
}
token = ecl_read_token(rtbl, in, 1);
token = ecl_read_token(rtbl, in, flags);
string = token->token.string;
if (TOKEN_STRING_FILLP(string) == 1) {
c = ECL_CODE_CHAR(TOKEN_STRING_CHAR(string,0));

2
src/h/external.h
View file

@ -1579,7 +1579,7 @@ extern ECL_API cl_object ecl_read_eval(cl_object in);
extern ECL_API cl_object ecl_read_object_non_recursive(cl_object in);
extern ECL_API cl_object ecl_read_object_with_delimiter(cl_object rtbl, cl_object in, int del, int flags);
extern ECL_API cl_object ecl_read_object(cl_object in);
extern ECL_API cl_object ecl_read_token(cl_object rtbl, cl_object in, bool esc);
extern ECL_API cl_object ecl_read_token(cl_object rtbl, cl_object in, int flags);
extern ECL_API cl_object ecl_parse_token(cl_object token, cl_object in, int flags);
extern ECL_API cl_object ecl_parse_number(cl_object s, cl_index start, cl_index end, cl_index *ep, unsigned int radix);
extern ECL_API cl_object ecl_parse_integer(cl_object s, cl_index start, cl_index end, cl_index *ep, unsigned int radix);

6
src/h/internal.h
View file

@ -578,8 +578,10 @@ extern ecl_off_t ecl_integer_to_off_t(cl_object offset);
# define TOKEN_ESCAPE_FILLP(s) ((s)->vector.fillp)
#define ECL_READ_RETURN_IGNORABLE 3
#define ECL_READ_LIST_DOT 4
#define ECL_READ_RETURN_IGNORABLE 1
#define ECL_READ_LIST_DOT 2
#define ECL_READ_SUPPRESS 4
#define ECL_READ_ESCAPE_FIRST 8
extern cl_object ecl_get_reader_token(void);
extern void ecl_put_reader_token(cl_object token);