bool pic_list_p(pic_value obj) { pic_value local, rapid; int i; /* Floyd's cycle-finding algorithm. */ local = rapid = obj; while (true) { /* advance rapid fast-forward; runs 2x faster than local */ for (i = 0; i < 2; ++i) { if (pic_pair_p(rapid)) { rapid = pic_pair_ptr(rapid)->cdr; } else { return pic_nil_p(rapid); } } /* advance local */ local = pic_pair_ptr(local)->cdr; if (pic_eq_p(local, rapid)) { return false; } } }
static pic_value pic_bool_eq_p(pic_state *pic) { pic_value x, y; pic_get_args(pic, "oo", &x, &y); return pic_bool_value(pic_eq_p(x, y)); }
pic_value pic_assq(pic_state *pic, pic_value key, pic_value assoc) { pic_value cell; enter: if (pic_nil_p(assoc)) return assoc; cell = pic_car(pic, assoc); if (pic_eq_p(key, pic_car(pic, cell))) return cell; assoc = pic_cdr(pic, assoc); goto enter; }
static pic_value pic_bool_boolean_eq_p(pic_state *pic) { size_t argc, i; pic_value *argv; pic_get_args(pic, "*", &argc, &argv); for (i = 0; i < argc; ++i) { if (! (pic_true_p(argv[i]) || pic_false_p(argv[i]))) { return pic_false_value(); } if (! pic_eq_p(argv[i], argv[0])) { return pic_false_value(); } } return pic_true_value(); }
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; } }