C++ pic_get_args函数代码示例

static pic_value
pic_blob_bytevector_copy_i(pic_state *pic)
{
  pic_blob *to, *from;
  int n;
  size_t at, start, end;

  n = pic_get_args(pic, "bkb|kk", &to, &at, &from, &start, &end);

  switch (n) {
  case 3:
    start = 0;
  case 4:
    end = from->len;
  }

  if (to == from && (start <= at && at < end)) {
    /* copy in reversed order */
    at += end - start;
    while (start < end) {
      to->data[--at] = from->data[--end];
    }
    return pic_none_value();
  }

  while (start < end) {
    to->data[at++] = from->data[start++];
  }

  return pic_none_value();
}

static pic_value
pic_blob_bytevector_copy(pic_state *pic)
{
  pic_blob *from, *to;
  int n;
  size_t start, end, i = 0;

  n = pic_get_args(pic, "b|kk", &from, &start, &end);

  switch (n) {
  case 1:
    start = 0;
  case 2:
    end = from->len;
  }

  if (end < start) {
    pic_errorf(pic, "make-bytevector: end index must not be less than start index");
  }

  to = pic_make_blob(pic, end - start);
  while (start < end) {
    to->data[i++] = from->data[start++];
  }

  return pic_obj_value(to);
}

static pic_value
pic_state_features(pic_state *pic)
{
  pic_get_args(pic, "");

  return pic->features;
}

static pic_value
pic_state_global_objects(pic_state *pic)
{
  pic_get_args(pic, "");

  return pic->globals;
}

static pic_value
weak_call(pic_state *pic)
{
  pic_value key, val, weak;
  int n;

  n = pic_get_args(pic, "o|o", &key, &val);

  if (! pic_obj_p(pic, key)) {
    pic_error(pic, "attempted to set a non-object key", 1, key);
  }

  weak = pic_closure_ref(pic, 0);

  if (n == 1) {
    if (! pic_weak_has(pic, weak, key)) {
      return pic_false_value(pic);
    }
    return pic_cons(pic, key, pic_weak_ref(pic, weak, key));
  } else {
    if (pic_undef_p(pic, val)) {
      if (pic_weak_has(pic, weak, key)) {
        pic_weak_del(pic, weak, key);
      }
    } else {
      pic_weak_set(pic, weak, key, val);
    }
    return pic_undef_value(pic);
  }
}

static pic_value
pic_weak_make_ephemeron(pic_state *pic)
{
  pic_get_args(pic, "");

  return pic_lambda(pic, weak_call, 1, pic_make_weak(pic));
}

static pic_value
pic_system_getenvs(pic_state *pic)
{
  char **envp;
  pic_value data = pic_nil_value();
  size_t ai = pic_gc_arena_preserve(pic);

  pic_get_args(pic, "");

  if (! pic->envp) {
    return pic_nil_value();
  }

  for (envp = pic->envp; *envp; ++envp) {
    pic_str *key, *val;
    int i;

    for (i = 0; (*envp)[i] != '='; ++i)
      ;

    key = pic_make_str(pic, *envp, i);
    val = pic_make_str_cstr(pic, getenv(pic_str_cstr(pic, key)));

    /* push */
    data = pic_acons(pic, pic_obj_value(key), pic_obj_value(val), data);

    pic_gc_arena_restore(pic, ai);
    pic_gc_protect(pic, data);
  }

  return data;
}

static pic_value
pic_str_list_to_string(pic_state *pic)
{
  pic_str *str;
  pic_value list, e, it;
  size_t i = 0;
  char *buf;

  pic_get_args(pic, "o", &list);

  if (pic_length(pic, list) == 0) {
    return pic_obj_value(pic_make_str(pic, NULL, 0));
  }

  buf = pic_malloc(pic, pic_length(pic, list));

  pic_try {
    pic_for_each (e, list, it) {
      pic_assert_type(pic, e, char);

      buf[i++] = pic_char(e);
    }

    str = pic_make_str(pic, buf, i);
  }

static pic_value
pic_str_string_for_each(pic_state *pic)
{
  struct pic_proc *proc;
  size_t argc, len, i, j;
  pic_value *argv, vals;

  pic_get_args(pic, "l*", &proc, &argc, &argv);

  if (argc == 0) {
    pic_errorf(pic, "string-map: one or more strings expected, but got zero");
  } else {
    pic_assert_type(pic, argv[0], str);
    len = pic_str_len(pic_str_ptr(argv[0]));
  }
  for (i = 1; i < argc; ++i) {
    pic_assert_type(pic, argv[i], str);

    len = len < pic_str_len(pic_str_ptr(argv[i]))
      ? len
      : pic_str_len(pic_str_ptr(argv[i]));
  }

  for (i = 0; i < len; ++i) {
    vals = pic_nil_value();
    for (j = 0; j < argc; ++j) {
      pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals);
    }
    pic_apply(pic, proc, vals);
  }

  return pic_undef_value();
}

static pic_value
cont_call(pic_state *pic)
{
  struct pic_proc *self = pic_get_proc(pic);
  int argc;
  pic_value *argv;
  int id;
  struct pic_cont *cc, *cont;

  pic_get_args(pic, "*", &argc, &argv);

  id = pic_int(pic_proc_env_ref(pic, self, "id"));

  /* check if continuation is alive */
  for (cc = pic->cc; cc != NULL; cc = cc->prev) {
    if (cc->id == id) {
      break;
    }
  }
  if (cc == NULL) {
    pic_errorf(pic, "calling dead escape continuation");
  }

  cont = pic_data_ptr(pic_proc_env_ref(pic, self, "escape"))->data;
  cont->results = pic_list_by_array(pic, argc, argv);

  pic_load_point(pic, cont);

  PIC_LONGJMP(pic, cont->jmp, 1);

  PIC_UNREACHABLE();
}

static pic_value
pic_repl_tty_p(pic_state *pic)
{
  pic_get_args(pic, "");

  return pic_bool_value(pic, (isatty(STDIN_FILENO)));
}

static pic_value
pic_number_exp(pic_state *pic)
{
  double f;

  pic_get_args(pic, "f", &f);
  return pic_float_value(pic, exp(f));
}

static pic_value
pic_port_port_open_p(pic_state *pic)
{
  struct pic_port *port;

  pic_get_args(pic, "p", &port);

  return pic_bool_value(port->status == PIC_PORT_OPEN);
}

static pic_value
pic_error_error_object_irritants(pic_state *pic)
{
  struct pic_error *e;

  pic_get_args(pic, "e", &e);

  return e->irrs;
}

static pic_value
pic_error_error_object_type(pic_state *pic)
{
  struct pic_error *e;

  pic_get_args(pic, "e", &e);

  return pic_obj_value(e->type);
}