mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-16 14:21:48 -08:00
Code Issues Projects Releases Packages Wiki Activity

src/c/read.d: the previous 'fix' for the circular reader lead to infinite recursion. This actual fix reimplements SBCL's strategy, using a hash table to prevent it.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-11-23 22:48:05 +01:00
parent e8b2573355
commit fc0fc51eae
1 changed files with 53 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

104
src/c/read.d
View file

@ -1214,15 +1214,15 @@ static cl_object
sharp_eq_reader(cl_object in, cl_object c, cl_object d)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object pair, value;
cl_object definition, pair, value;
cl_object sharp_eq_context = ECL_SYM_VAL(the_env, @'si::*sharp-eq-context*');
if (read_suppress) @(return)
if (Null(d))
FEreader_error("The #= readmacro requires an argument.", in, 0);
if (ecl_assql(d, sharp_eq_context) != Cnil)
if (ecl_assq(d, sharp_eq_context) != Cnil)
FEreader_error("Duplicate definitions for #~D=.", in, 1, d);
pair = CONS(d, OBJNULL);
pair = CONS(d, Cnil);
ECL_SETQ(the_env, @'si::*sharp-eq-context*', CONS(pair, sharp_eq_context));
value = ecl_read_object(in);
if (value == pair)
@ -1235,7 +1235,7 @@ static cl_object
sharp_sharp_reader(cl_object in, cl_object c, cl_object d)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object pair, value;
cl_object pair;
if (read_suppress)
@(return Cnil)
@ -1244,51 +1244,53 @@ sharp_sharp_reader(cl_object in, cl_object c, cl_object d)
pair = ecl_assq(d, ECL_SYM_VAL(the_env, @'si::*sharp-eq-context*'));
if (pair == Cnil)
FEreader_error("#~D# is undefined.", in, 1, d);
value = ECL_CONS_CDR(pair);
@(return ((value == OBJNULL)? pair : value))
@(return pair)
}
static cl_object
do_patch_sharp(cl_object x)
do_patch_sharp(cl_object x, cl_object table)
{
switch (type_of(x)) {
case t_list: {
cl_object y = x;
cl_object *place = &x;
if (Null(x))
break;
do {
/* This was the result of a #d# */
if (CAR(y) == OBJNULL) {
*place = CDR(y);
return x;
} else {
ECL_RPLACA(y, do_patch_sharp(CAR(y)));
}
place = &ECL_CONS_CDR(y);
y = ECL_CONS_CDR(y);
} while (CONSP(y));
break;
case t_list:
if (Null(x))
return x;
case t_vector:
case t_array:
case t_complex:
case t_bclosure:
case t_bytecodes: {
cl_object y = ecl_gethash_safe(x, table, table);
if (y == table)
break;
x = y;
}
default:
return x;
}
switch (type_of(x)) {
case t_list:
ECL_RPLACA(x, do_patch_sharp(ECL_CONS_CAR(x), table));
ECL_RPLACD(x, do_patch_sharp(ECL_CONS_CDR(x), table));
break;
case t_vector:
if (x->vector.elttype == aet_object) {
cl_index i;
for (i = 0; i < x->vector.fillp; i++)
x->vector.self.t[i] = do_patch_sharp(x->vector.self.t[i]);
x->vector.self.t[i] =
do_patch_sharp(x->vector.self.t[i], table);
}
break;
case t_array:
if (x->vector.elttype == aet_object) {
cl_index i, j;
for (i = 0, j = 1; i < x->array.rank; i++)
j *= x->array.dims[i];
cl_index i, j = x->array.dim;
for (i = 0; i < j; i++)
x->array.self.t[i] = do_patch_sharp(x->array.self.t[i]);
x->array.self.t[i] =
do_patch_sharp(x->array.self.t[i], table);
}
break;
case t_complex: {
cl_object r = do_patch_sharp(x->complex.real);
cl_object i = do_patch_sharp(x->complex.imag);
cl_object r = do_patch_sharp(x->complex.real, table);
cl_object i = do_patch_sharp(x->complex.imag, table);
if (r != x->complex.real || i != x->complex.imag) {
cl_object c = ecl_make_complex(r, i);
x->complex = c->complex;
@ -1296,43 +1298,43 @@ do_patch_sharp(cl_object x)
break;
}
case t_bclosure: {
x->bclosure.lex = do_patch_sharp(x->bclosure.lex);
x = x->bclosure.code = do_patch_sharp(x->bclosure.code);
x->bclosure.lex = do_patch_sharp(x->bclosure.lex, table);
x = x->bclosure.code = do_patch_sharp(x->bclosure.code, table);
break;
}
case t_bytecodes: {
cl_index i = 0;
x->bytecodes.name = do_patch_sharp(x->bytecodes.name);
x->bytecodes.definition = do_patch_sharp(x->bytecodes.definition);
x->bytecodes.name = do_patch_sharp(x->bytecodes.name, table);
x->bytecodes.definition = do_patch_sharp(x->bytecodes.definition, table);
for (i = 0; i < x->bytecodes.data_size; i++) {
x->bytecodes.data[i] = do_patch_sharp(x->bytecodes.data[i]);
x->bytecodes.data[i] =
do_patch_sharp(x->bytecodes.data[i], table);
}
break;
}
default:;
}
return(x);
ecl_sethash(x, table, x);
return x;
}
static cl_object
patch_sharp(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object sharp_eq_context = ECL_SYM_VAL(the_env, @'si::*sharp-eq-context*');
cl_object pairs;
cl_object table =
cl__make_hash_table(@'eq', MAKE_FIXNUM(20), /* size */
ecl_make_singlefloat(1.5f), /* rehash-size */
ecl_make_singlefloat(0.5f), /* rehash-threshold */
Cnil); /* thread-safe */
pairs = sharp_eq_context;
loop_for_in(pairs) {
cl_object pair = ECL_CONS_CAR(pairs);
ECL_RPLACA(pair, OBJNULL);
} end_loop_for_in;
x = do_patch_sharp(x);
pairs = sharp_eq_context;
loop_for_in(pairs) {
cl_object pair = ECL_CONS_CAR(pairs);
ECL_RPLACA(pair, Cnil);
} end_loop_for_in;
pairs = ECL_SYM_VAL(the_env, @'si::*sharp-eq-context*');
loop_for_in(pairs) {
cl_object pair = ECL_CONS_CAR(pairs);
ecl_sethash(pair, table, ECL_CONS_CDR(pair));
} end_loop_for_in;
x = do_patch_sharp(x, table);
return x;
}