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

reader: factor out ecl_read_token from ecl_read_object_with_delimiter

Browse source
This commit is contained in:
Daniel Kochmański 2026-03-01 22:15:11 +01:00
parent a4504dc1a3
commit 8a13a9e85f
4 changed files with 60 additions and 56 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/c/read.d
View file

@ -122,7 +122,7 @@ ecl_read_object_non_recursive(cl_object in)
cl_object
ecl_read_object(cl_object in)
{
return ecl_read_object_with_delimiter(in, EOF, 0, cat_constituent);
return ecl_read_object_with_delimiter(in, EOF, 0);
}
cl_object
@ -133,8 +133,7 @@ si_read_object_or_ignore(cl_object in, cl_object eof)
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(in, EOF, ECL_READ_RETURN_IGNORABLE,
cat_constituent);
x = ecl_read_object_with_delimiter(in, EOF, ECL_READ_RETURN_IGNORABLE);
if (x == OBJNULL) {
env->nvalues = 1;
x = eof;
@ -417,8 +416,7 @@ ecl_read_delimited_list(int d, cl_object in, bool proper_list)
cl_object x, y = ECL_NIL;
cl_object *p = &y;
do {
x = ecl_read_object_with_delimiter(in, d, ECL_READ_LIST_DOT,
cat_constituent);
x = ecl_read_object_with_delimiter(in, d, ECL_READ_LIST_DOT);
if (x == OBJNULL) {
/* End of the list. */
unlikely_if (after_dot == 1) {

99
src/c/reader.d
View file

@ -115,11 +115,10 @@ ecl_dispatch_reader_fun(cl_object in, cl_object dc)
}
cl_object
ecl_read_object_with_delimiter(cl_object in, int delimiter, int flags,
enum ecl_chattrib a)
ecl_read_token(cl_object in, int flags, int c, enum ecl_chattrib a)
{
cl_object x, token;
int c, base;
int base;
cl_object p;
cl_index length, i;
int colon, intern_flag;
@ -131,50 +130,10 @@ ecl_read_object_with_delimiter(cl_object in, int delimiter, int flags,
cl_fixnum upcase; /* # uppercase characters - # downcase characters */
cl_fixnum count; /* number of unescaped characters */
bool suppress = read_suppress;
if (a != cat_constituent) {
c = 0;
goto LOOP;
}
BEGIN:
do {
c = ecl_read_char(in);
if (c == delimiter) {
the_env->nvalues = 0;
return OBJNULL;
}
if (c == EOF)
FEend_of_file(in);
a = ecl_readtable_get(rtbl, c, &x);
} while (a == cat_whitespace);
if ((a == cat_terminating || a == cat_non_terminating) &&
(flags != ECL_READ_ONLY_TOKEN)) {
cl_object o;
if (ECL_HASH_TABLE_P(x)) {
if (suppress) {
o = dispatch_macro_character(x, in, c, FALSE);
if (o == OBJNULL)
goto BEGIN;
} else {
o = dispatch_macro_character(x, in, c, TRUE);
}
} else {
o = _ecl_funcall3(x, in, ECL_CODE_CHAR(c));
}
if (the_env->nvalues == 0) {
if (flags == ECL_READ_RETURN_IGNORABLE)
return ECL_NIL;
goto BEGIN;
}
unlikely_if (the_env->nvalues > 1) {
FEerror("The readmacro ~S returned ~D values.",
2, x, ecl_make_fixnum(the_env->nvalues));
}
return o;
}
LOOP:
p = escape_list = ECL_NIL;
upcase = count = length = 0;
external_symbol = colon = 0;
colon = upcase = count = length = 0;
external_symbol = 0;
token = si_get_buffer_string();
for (;;) {
if (c == ':' && (flags != ECL_READ_ONLY_TOKEN) &&
@ -358,3 +317,51 @@ ecl_read_object_with_delimiter(cl_object in, int delimiter, int flags,
the_env->nvalues = 1;
return x;
}
cl_object
ecl_read_object_with_delimiter(cl_object in, int delimiter, int flags)
{
cl_object x;
int c;
enum ecl_chattrib a;
cl_env_ptr the_env = ecl_process_env();
cl_object rtbl = ecl_current_readtable();
bool suppress = read_suppress;
BEGIN:
do {
c = ecl_read_char(in);
if (c == delimiter) {
the_env->nvalues = 0;
return OBJNULL;
}
if (c == EOF)
FEend_of_file(in);
a = ecl_readtable_get(rtbl, c, &x);
} while (a == cat_whitespace);
if ((a == cat_terminating || a == cat_non_terminating) &&
(flags != ECL_READ_ONLY_TOKEN)) {
cl_object o;
if (ECL_HASH_TABLE_P(x)) {
if (suppress) {
o = dispatch_macro_character(x, in, c, FALSE);
if (o == OBJNULL)
goto BEGIN;
} else {
o = dispatch_macro_character(x, in, c, TRUE);
}
} else {
o = _ecl_funcall3(x, in, ECL_CODE_CHAR(c));
}
if (the_env->nvalues == 0) {
if (flags == ECL_READ_RETURN_IGNORABLE)
return ECL_NIL;
goto BEGIN;
}
unlikely_if (the_env->nvalues > 1) {
FEerror("The readmacro ~S returned ~D values.",
2, x, ecl_make_fixnum(the_env->nvalues));
}
return o;
}
return ecl_read_token(in, flags, c, a);
}

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

@ -219,8 +219,7 @@ sharp_backslash_reader(cl_object in, cl_object c, cl_object d)
FEreader_error("~S is an illegal CHAR-FONT.", in, 1, d);
}
}
token = ecl_read_object_with_delimiter(in, EOF, ECL_READ_ONLY_TOKEN,
cat_single_escape);
token = ecl_read_token(in, ECL_READ_ONLY_TOKEN, 0, cat_single_escape);
if (token == ECL_NIL) {
c = ECL_NIL;
} else if (TOKEN_STRING_FILLP(token) == 1) {
@ -420,8 +419,7 @@ sharp_left_parenthesis_reader(cl_object in, cl_object c, cl_object d)
cl_index dim = ecl_fixnum(d), i;
v = ecl_alloc_simple_vector(dim, ecl_aet_object);
for (i = 0, last = ECL_NIL;; i++) {
cl_object aux = ecl_read_object_with_delimiter(in, ')', 0,
cat_constituent);
cl_object aux = ecl_read_object_with_delimiter(in, ')', 0);
if (aux == OBJNULL)
break;
unlikely_if (i >= dim) {

3
src/h/external.h
View file

@ -1576,8 +1576,9 @@ extern ECL_API cl_object ecl_read_delimited_list(int d, cl_object strm, bool pro
extern ECL_API cl_object ecl_dispatch_reader_fun(cl_object in, cl_object dc);
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 in, int del, int flags, enum ecl_chattrib a);
extern ECL_API cl_object ecl_read_object_with_delimiter(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 in, int flags, int c, enum ecl_chattrib a);
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);
extern ECL_API bool ecl_invalid_character_p(int c);