implement circular refarence checking

This commit is contained in:
Sunrim KIM (keen) 2014-06-18 00:47:50 +09:00
parent dcef9579f5
commit d706240ada
1 changed files with 84 additions and 20 deletions

View File

@ -10,33 +10,87 @@
#include "picrin/blob.h" #include "picrin/blob.h"
#include "picrin/string.h" #include "picrin/string.h"
bool bool pic_string_equal_p(struct pic_string *str1, struct pic_string *str2)
pic_equal_p(pic_state *pic, pic_value x, pic_value y)
{ {
return pic_strcmp(str1, str2) == 0;
}
bool pic_blob_equal_p(struct pic_blob *blob1, struct pic_blob *blob2)
{
if(blob1->len != blob2->len){
return false;
}
size_t i;
for(i = 0; i < blob1->len; ++i){
if(blob1->data[i] != blob2->data[i])
return false;
}
return true;
}
bool
pic_internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *ht)
{
if (depth > 10){
if(depth > 200){
pic_errorf(pic, "Stack overflow in equal\n");
}
if (NULL == ht){
xh_init_ptr(ht, sizeof(void *));
}
switch(pic_type(x)){
case PIC_TT_PAIR:
case PIC_TT_VECTOR:{
xh_entry *e = xh_get(ht, pic_obj_ptr(x));
if(e){
/* `x' was seen already. */
return true;
}else{
xh_put(ht, pic_obj_ptr(x), NULL);
}
}
default:;
}
}
enum pic_tt type; enum pic_tt type;
pic_value local = pic_nil_value();
size_t rapid_count = 0;
LOOP:
if (pic_eqv_p(x, y)) if (pic_eqv_p(x, y))
return true; return true;
type = pic_type(x); type = pic_type(x);
if (type != pic_type(y))
if (type != pic_type(y)){
return false; return false;
}
switch (type) { switch (type) {
case PIC_TT_PAIR: case PIC_TT_PAIR:
return pic_equal_p(pic, pic_car(pic, x), pic_car(pic, y)) if(pic_nil_p(local)){
&& pic_equal_p(pic, pic_cdr(pic, x), pic_cdr(pic, y)); local = x;
case PIC_TT_BLOB: { }
int i; if(pic_internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, ht)){
struct pic_blob *v1 = pic_blob_ptr(x), *v2 = pic_blob_ptr(y); x = pic_cdr(pic, x);
if(v1->len != v2->len){ y = pic_cdr(pic, y);
++rapid_count;
if(rapid_count == 2){
rapid_count = 0;
local = pic_cdr(pic, local);
if (pic_eq_p(local, x)) {
return true;
}
}
goto LOOP;
}else{
return false; return false;
} }
for(i = 0; i < v1->len; ++i){
if(v1->data[i] != v2->data[i])
return false;
}
return true;
}
case PIC_TT_VECTOR:{ case PIC_TT_VECTOR:{
size_t i; size_t i;
struct pic_vector *v1 = pic_vec_ptr(x), *v2 = pic_vec_ptr(y); struct pic_vector *v1 = pic_vec_ptr(x), *v2 = pic_vec_ptr(y);
@ -45,18 +99,28 @@ pic_equal_p(pic_state *pic, pic_value x, pic_value y)
return false; return false;
} }
for(i = 0; i < v1->len; ++i){ for(i = 0; i < v1->len; ++i){
if(! pic_equal_p(pic, v1->data[i], v2->data[i])) if(! pic_internal_equal_p(pic, v1->data[i], v2->data[i], depth + 1, ht)){
return false; return false;
}
} }
return true; return true;
} }
case PIC_TT_BLOB:
return pic_blob_equal_p(pic_blob_ptr(x), pic_blob_ptr(y));
case PIC_TT_STRING: case PIC_TT_STRING:
return pic_strcmp(pic_str_ptr(x), pic_str_ptr(y)) == 0; return pic_string_equal_p(pic_str_ptr(x), pic_str_ptr(y));
default: default:
return false; return false;
} }
} }
bool
pic_equal_p(pic_state *pic, pic_value x, pic_value y){
xhash ht;
xh_init_ptr(&ht, 0);
return pic_internal_equal_p(pic, x, y, 0, &ht);
}
static pic_value static pic_value
pic_bool_eq_p(pic_state *pic) pic_bool_eq_p(pic_state *pic)
{ {