conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

use khash in equal? impl

This commit is contained in:
Yuichi Nishiwaki 2015-06-25 06:44:45 +09:00
parent d6edf41305
commit 03a649ed23
1 changed files with 54 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
extlib/benz/bool.c
View File

@ -4,17 +4,56 @@
#include "picrin.h"
static bool
str_equal_p(pic_state *pic, struct pic_string *str1, struct pic_string *str2)
{
return pic_str_cmp(pic, str1, str2) == 0;
}
KHASH_DECLARE(m, void *, int)
KHASH_DEFINE2(m, void *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal)
static bool
blob_equal_p(struct pic_blob *blob1, struct pic_blob *blob2)
internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, khash_t(m) *h)
{
pic_value local = pic_nil_value();
size_t c = 0;
if (depth > 10) {
if (depth > 200) {
pic_errorf(pic, "Stack overflow in equal\n");
}
if (pic_pair_p(x) || pic_vec_p(x)) {
int ret;
kh_put(m, h, pic_obj_ptr(x), &ret);
if (ret != 0) {
return true; /* `x' was seen already. */
}
}
}
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_ID: {
struct pic_id *id1, *id2;
id1 = pic_id_ptr(x);
id2 = pic_id_ptr(y);
return pic_resolve(pic, id1->var, id1->env) == pic_resolve(pic, id2->var, id2->env);
}
case PIC_TT_STRING: {
return pic_str_cmp(pic, pic_str_ptr(x), pic_str_ptr(y)) == 0;
}
case PIC_TT_BLOB: {
pic_blob *blob1, *blob2;
size_t i;
blob1 = pic_blob_ptr(x);
blob2 = pic_blob_ptr(y);
if (blob1->len != blob2->len) {
return false;
}
@ -24,58 +63,17 @@ blob_equal_p(struct pic_blob *blob1, struct pic_blob *blob2)
}
return true;
}
static bool
internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *xh, bool xh_initted_p)
{
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_initted_p) {
xh_init_ptr(xh, 0);
xh_initted_p = true;
}
if (xh_get_ptr(xh, pic_obj_ptr(x)) != NULL) {
return true; /* `x' was seen already. */
} else {
xh_put_ptr(xh, pic_obj_ptr(x), NULL);
}
}
}
c = 0;
LOOP:
if (pic_eqv_p(x, y))
return true;
if (pic_type(x) != pic_type(y))
case PIC_TT_PAIR: {
if (! internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, h))
return false;
switch (pic_type(x)) {
case PIC_TT_STRING:
return str_equal_p(pic, 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: {
/* Floyd's cycle-finding algorithm */
if (pic_nil_p(local)) {
local = x;
}
if (internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, xh, xh_initted_p)) {
x = pic_cdr(pic, x);
y = pic_cdr(pic, y);
c++;
if (c == 2) {
c = 0;
local = pic_cdr(pic, local);
@ -83,10 +81,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
return true;
}
}
goto LOOP;
} else {
return false;
}
goto LOOP; /* tail-call optimization */
}
case PIC_TT_VECTOR: {
size_t i;
@ -99,19 +94,11 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
return false;
}
for (i = 0; i < u->len; ++i) {
if (! internal_equal_p(pic, u->data[i], v->data[i], depth + 1, xh, xh_initted_p))
if (! internal_equal_p(pic, u->data[i], v->data[i], depth + 1, h))
return false;
}
return true;
}
case PIC_TT_ID: {
struct pic_id *id1, *id2;
id1 = pic_id_ptr(x);
id2 = pic_id_ptr(y);
return pic_resolve(pic, id1->var, id1->env) == pic_resolve(pic, id2->var, id2->env);
}
default:
return false;
}
@ -120,9 +107,11 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
bool
pic_equal_p(pic_state *pic, pic_value x, pic_value y)
{
xhash ht;
khash_t(m) h;
return internal_equal_p(pic, x, y, 0, &ht, false);
kh_init(m, &h);
return internal_equal_p(pic, x, y, 0, &h);
}
static pic_value