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

reader: store escape intervals on a stack

Browse source 
To enable access from both sides we store escape intervals in a vector (a
stack). This also fixes #813.
This commit is contained in:
Daniel Kochmański 2026-03-02 13:04:35 +01:00
parent 832850bdee
commit 2b36abd0b7
1 changed files with 53 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

95
src/c/reader.d
View file

@ -29,40 +29,39 @@
/*
* This routine inverts the case of the characters in the buffer which were not
* escaped. ESCAPE_LIST is a list of intevals of characters that were escaped,
* as in ({(low-limit . high-limit)}*). The list goes from the last interval to
* the first one, in reverse order, and thus we run the buffer from the end to
* the beginning.
* escaped. ESCAPE_INTERVALS is a vector of intevals of characters that were
* escaped, as in ({(low-limit . high-limit)}*).
*/
static void
invert_buffer_case(cl_object x, cl_object escape_list, int sign)
invert_buffer_case(cl_object x, cl_object escape_intervals, int sign)
{
cl_fixnum high_limit, low_limit;
cl_fixnum i = TOKEN_STRING_FILLP(x)-1;
do {
if (escape_list != ECL_NIL) {
cl_object escape_interval = CAR(escape_list);
high_limit = ecl_fixnum(CAR(escape_interval));
low_limit = ecl_fixnum(CDR(escape_interval));
escape_list = CDR(escape_list);
} else {
high_limit = low_limit = -1;
}
for (; i > high_limit; i--) {
/* The character is not escaped */
int c = TOKEN_STRING_CHAR(x,i);
cl_fixnum str_i = 0, esc_index = 0;
int c;
/* see whether we have a bug with reversed beginning/end */
loop_across_stack_fifo(eint, escape_intervals) {
low_limit = ecl_fixnum(CAR(eint));
high_limit = ecl_fixnum(CDR(eint));
for(; str_i<low_limit; str_i++) {
c = TOKEN_STRING_CHAR(x,str_i);
if (ecl_upper_case_p(c) && (sign < 0)) {
c = ecl_char_downcase(c);
} else if (ecl_lower_case_p(c) && (sign > 0)) {
c = ecl_char_upcase(c);
}
TOKEN_STRING_CHAR_SET(x,i,c);
TOKEN_STRING_CHAR_SET(x,str_i,c);
}
for (; i > low_limit; i--) {
/* The character is within an escaped interval */
;
str_i=high_limit;
} end_loop_across_stack();
for (; str_i < ecl_length(x); str_i++) {
c = TOKEN_STRING_CHAR(x,str_i);
if (ecl_upper_case_p(c) && (sign < 0)) {
c = ecl_char_downcase(c);
} else if (ecl_lower_case_p(c) && (sign > 0)) {
c = ecl_char_upcase(c);
}
} while (i >= 0);
TOKEN_STRING_CHAR_SET(x,str_i,c);
}
}
/*
@ -127,15 +126,16 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
cl_env_ptr the_env = ecl_process_env();
cl_object rtbl = ecl_current_readtable();
enum ecl_readtable_case read_case = rtbl->readtable.read_case;
cl_object escape_list; /* intervals of escaped characters */
cl_object escape_intervals; /* intervals of escaped characters */
cl_fixnum upcase; /* # uppercase characters - # downcase characters */
cl_fixnum count; /* number of unescaped characters */
bool suppress = read_suppress;
p = escape_list = ECL_NIL;
p = ECL_NIL;
colon = upcase = count = length = 0;
external_symbol = 0;
token = si_get_buffer_string();
escape_intervals = ecl_make_stack(0);
if (escape_first_p) {
c = 0;
@ -163,9 +163,9 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
* had the same case, we revert their case. */
if (read_case == ecl_case_invert && count != 0) {
if (upcase == count) {
invert_buffer_case(token, escape_list, -1);
invert_buffer_case(token, escape_intervals, -1);
} else if (upcase == -count) {
invert_buffer_case(token, escape_list, +1);
invert_buffer_case(token, escape_intervals, +1);
}
}
if (length == 0) {
@ -182,20 +182,21 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
*/
cl_object name = cl_copy_seq(token);
unlikely_if (Null(the_env->packages_to_be_created_p)) {
ecl_free_stack(escape_intervals);
si_put_buffer_string(token);
FEerror("There is no package with the name ~A.", 1, name);
}
p = _ecl_package_to_be_created(the_env, name);
}
TOKEN_STRING_FILLP(token) = length = 0;
upcase = count = colon = 0;
escape_list = ECL_NIL;
ecl_wipe_stack(escape_intervals);
}
if (a == cat_single_escape) {
c = ecl_read_char_noeof(in);
a = cat_constituent;
escape_list = CONS(CONS(ecl_make_fixnum(length),
ecl_make_fixnum(length-1)),
escape_list);
ecl_stack_push(escape_intervals, CONS(ecl_make_fixnum(length-1),
ecl_make_fixnum(length)));
ecl_string_push_extend(token, c);
length++;
goto NEXT;
@ -213,9 +214,8 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
ecl_string_push_extend(token, c);
length++;
}
escape_list = CONS(CONS(ecl_make_fixnum(begin),
ecl_make_fixnum(length-1)),
escape_list);
ecl_stack_push(escape_intervals, CONS(ecl_make_fixnum(begin),
ecl_make_fixnum(length-1)));
goto NEXT;
}
if (a == cat_whitespace || a == cat_terminating) {
@ -223,6 +223,8 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
break;
}
unlikely_if (ecl_invalid_character_p(c) && !suppress) {
ecl_free_stack(escape_intervals);
si_put_buffer_string(token);
FEreader_error("Found invalid character ~:C", in, 1, ECL_CODE_CHAR(c));
}
if (read_case != ecl_case_preserve) {
@ -254,7 +256,7 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
/* If there are some escaped characters, it must be a symbol */
if ((flags == ECL_READ_ONLY_TOKEN) || p != ECL_NIL ||
escape_list != ECL_NIL || length == 0)
ecl_length(escape_intervals) != 0 || length == 0)
goto SYMBOL;
/* The case in which the buffer is full of dots has to be especial cased */
@ -263,6 +265,8 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
x = @'si::.';
goto OUTPUT;
} else {
ecl_free_stack(escape_intervals);
si_put_buffer_string(token);
FEreader_error("Dots appeared illegally.", in, 0);
}
} else {
@ -271,6 +275,8 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
if (!TOKEN_STRING_CHAR_CMP(token,i,'.'))
goto MAYBE_NUMBER;
}
ecl_free_stack(escape_intervals);
si_put_buffer_string(token);
FEreader_error("Dots appeared illegally.", in, 0);
}
@ -280,15 +286,18 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
if ((base <= 10) && ecl_alpha_char_p(TOKEN_STRING_CHAR(token,0)))
goto SYMBOL;
x = ecl_parse_number(token, 0, TOKEN_STRING_FILLP(token), &i, base);
unlikely_if (x == ECL_NIL)
unlikely_if (x == ECL_NIL) {
ecl_free_stack(escape_intervals);
si_put_buffer_string(token);
FEreader_error("Syntax error when reading number.~%Offending string: ~S.",
in, 1, token);
}
if (x != OBJNULL && length == i)
goto OUTPUT;
SYMBOL:
if (flags == ECL_READ_ONLY_TOKEN) {
the_env->nvalues = 1;
return token;
ecl_free_stack(escape_intervals);
ecl_return1(the_env, token);
}
/*TOKEN_STRING_CHAR_SET(token,length,'\0');*/
@ -296,14 +305,16 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
* had the same case, we revert their case. */
if (read_case == ecl_case_invert && count != 0) {
if (upcase == count) {
invert_buffer_case(token, escape_list, -1);
invert_buffer_case(token, escape_intervals, -1);
} else if (upcase == -count) {
invert_buffer_case(token, escape_list, +1);
invert_buffer_case(token, escape_intervals, +1);
}
}
if (external_symbol) {
x = ecl_find_symbol(token, p, &intern_flag);
unlikely_if (intern_flag != ECL_EXTERNAL) {
ecl_free_stack(escape_intervals);
si_put_buffer_string(token);
FEreader_error("Cannot find the external symbol ~A in ~S.", in,
2, cl_copy_seq(token), p);
}
@ -315,9 +326,9 @@ ecl_read_token(cl_object in, int flags, bool escape_first_p)
x = ecl_intern(token, p, &intern_flag);
}
OUTPUT:
ecl_free_stack(escape_intervals);
si_put_buffer_string(token);
the_env->nvalues = 1;
return x;
ecl_return1(the_env, x);
}
cl_object