static pic_value
pic_bool_eqv_p(pic_state *pic)
{
pic_value x, y;
pic_get_args(pic, "oo", &x, &y);
return pic_bool_value(pic_eqv_p(x, y));
}
bool
pic_equal_p(pic_state *pic, pic_value x, pic_value y)
{
enum pic_tt type;
if (pic_eqv_p(x, y))
return true;
type = pic_type(x);
if (type != pic_type(y))
return false;
switch (type) {
case PIC_TT_PAIR:
return pic_equal_p(pic, pic_car(pic, x), pic_car(pic, y))
&& pic_equal_p(pic, pic_cdr(pic, x), pic_cdr(pic, y));
default:
return false;
}
}
static bool
internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *ht)
{
pic_value local = pic_nil_value();
size_t c;
if (depth > 10) {
if (depth > 200) {
pic_errorf(pic, "Stack overflow in equal\n");
}
if (pic_pair_p(x) || pic_vec_p(x)) {
if (xh_get_ptr(ht, pic_obj_ptr(x)) != NULL) {
return true; /* `x' was seen already. */
} else {
xh_put_ptr(ht, pic_obj_ptr(x), NULL);
}
}
}
c = 0;
LOOP:
if (pic_eqv_p(x, y))
return true;
if (pic_type(x) != pic_type(y))
return false;
switch (pic_type(x)) {
case PIC_TT_STRING:
return str_equal_p(pic_str_ptr(x), pic_str_ptr(y));
case PIC_TT_BLOB:
return blob_equal_p(pic_blob_ptr(x), pic_blob_ptr(y));
case PIC_TT_PAIR: {
if (pic_nil_p(local)) {
local = x;
}
if (internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, ht)) {
x = pic_cdr(pic, x);
y = pic_cdr(pic, y);
c++;
if (c == 2) {
c = 0;
local = pic_cdr(pic, local);
if (pic_eq_p(local, x)) {
return true;
}
}
goto LOOP;
} else {
return false;
}
}
case PIC_TT_VECTOR: {
size_t i;
struct pic_vector *u, *v;
u = pic_vec_ptr(x);
v = pic_vec_ptr(y);
if (u->len != v->len) {
return false;
}
for (i = 0; i < u->len; ++i) {
if (! internal_equal_p(pic, u->data[i], v->data[i], depth + 1, ht))
return false;
}
return true;
}
default:
return false;
}
}
