support (equal? identifier1 identifier2)
This commit is contained in:
parent
cf66d600bb
commit
7dd0e01b70
|
@ -104,6 +104,14 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
|
||||||
}
|
}
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
case PIC_TT_ID: {
|
||||||
|
struct pic_id *id1, *id2;
|
||||||
|
|
||||||
|
id1 = pic_id_ptr(x);
|
||||||
|
id2 = pic_id_ptr(y);
|
||||||
|
|
||||||
|
return pic_eq_p(pic_expand(pic, id1->var, id1->env), pic_expand(pic, id2->var, id2->env));
|
||||||
|
}
|
||||||
default:
|
default:
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
|
@ -152,24 +152,20 @@ pic_macro_variable_p(pic_state *pic)
|
||||||
static pic_value
|
static pic_value
|
||||||
pic_macro_variable_eq_p(pic_state *pic)
|
pic_macro_variable_eq_p(pic_state *pic)
|
||||||
{
|
{
|
||||||
pic_value var1, var2;
|
size_t argc, i;
|
||||||
|
pic_value *argv;
|
||||||
|
|
||||||
pic_get_args(pic, "oo", &var1, &var2);
|
pic_get_args(pic, "*", &argc, &argv);
|
||||||
|
|
||||||
pic_assert_type(pic, var1, var);
|
for (i = 0; i < argc; ++i) {
|
||||||
pic_assert_type(pic, var2, var);
|
if (! pic_var_p(argv[i])) {
|
||||||
|
|
||||||
if (pic_sym_p(var1) && pic_sym_p(var2)) {
|
|
||||||
return pic_bool_value(pic_eq_p(var1, var2));
|
|
||||||
}
|
|
||||||
if (pic_id_p(var1) && pic_id_p(var2)) {
|
|
||||||
struct pic_id *id1, *id2;
|
|
||||||
|
|
||||||
id1 = pic_id_ptr(var1);
|
|
||||||
id2 = pic_id_ptr(var2);
|
|
||||||
return pic_bool_value(pic_eq_p(pic_expand(pic, id1->var, id1->env), pic_expand(pic, id2->var, id2->env)));
|
|
||||||
}
|
|
||||||
return pic_false_value();
|
return pic_false_value();
|
||||||
|
}
|
||||||
|
if (! pic_equal_p(pic, argv[i], argv[0])) {
|
||||||
|
return pic_false_value();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return pic_true_value();
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
Loading…
Reference in New Issue