avoid paths in case-lambda names

Filter absolute path names for `case-lambda` in the same way as for
`lambda`.
This commit is contained in:
Matthew Flatt 2015-12-09 15:25:01 -07:00
parent 70ee04d257
commit 2743ea06bb

View File

@ -94,6 +94,7 @@ static Scheme_Object *read_top_level_require(Scheme_Object *obj);
static Scheme_Object *write_top_level_require(Scheme_Object *obj); static Scheme_Object *write_top_level_require(Scheme_Object *obj);
static Scheme_Object *ht_to_vector(Scheme_Object *ht, int delay); static Scheme_Object *ht_to_vector(Scheme_Object *ht, int delay);
static Scheme_Object *closure_marshal_name(Scheme_Object *name);
void scheme_init_marshal(Scheme_Env *env) void scheme_init_marshal(Scheme_Env *env)
{ {
@ -365,7 +366,7 @@ static Scheme_Object *write_case_lambda(Scheme_Object *obj)
l = cons(cl->array[i], l); l = cons(cl->array[i], l);
} }
return cons((cl->name ? cl->name : scheme_null), return cons(closure_marshal_name(cl->name),
l); l);
} }
@ -759,17 +760,9 @@ static int not_relative_path(Scheme_Object *p, Scheme_Hash_Table *cache)
return 0; return 0;
} }
static Scheme_Object *write_compiled_closure(Scheme_Object *obj) static Scheme_Object *closure_marshal_name(Scheme_Object *name)
{ {
Scheme_Closure_Data *data; if (name) {
Scheme_Object *name, *l, *code, *ds, *tl_map;
int svec_size, pos;
Scheme_Marshal_Tables *mt;
data = (Scheme_Closure_Data *)obj;
if (data->name) {
name = data->name;
if (SCHEME_VECTORP(name)) { if (SCHEME_VECTORP(name)) {
/* We can only save marshalable src names, which includes /* We can only save marshalable src names, which includes
paths, symbols, and strings: */ paths, symbols, and strings: */
@ -786,9 +779,22 @@ static Scheme_Object *write_compiled_closure(Scheme_Object *obj)
name = SCHEME_VEC_ELS(name)[0]; name = SCHEME_VEC_ELS(name)[0];
} }
} }
} else { } else
name = scheme_null; name = scheme_null;
}
return name;
}
static Scheme_Object *write_compiled_closure(Scheme_Object *obj)
{
Scheme_Closure_Data *data;
Scheme_Object *name, *l, *code, *ds, *tl_map;
int svec_size, pos;
Scheme_Marshal_Tables *mt;
data = (Scheme_Closure_Data *)obj;
name = closure_marshal_name(data->name);
svec_size = data->closure_size; svec_size = data->closure_size;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) { if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {