implement circular refarence checking
This commit is contained in:
parent
dcef9579f5
commit
d706240ada
104
src/bool.c
104
src/bool.c
|
@ -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))
|
|
||||||
return false;
|
if (type != pic_type(y)){
|
||||||
|
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)
|
||||||
{
|
{
|
||||||
|
|
Loading…
Reference in New Issue