Example #1
0
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;
    }
  }
}
Example #2
0
File: bool.c Project: hiromu/picrin
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));
}
Example #3
0
File: pair.c Project: hiromu/picrin
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;
}
Example #4
0
File: bool.c Project: KeenS/benz
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();
}
Example #5
0
File: bool.c Project: KeenS/benz
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;
  }
}