예제 #1
0
파일: vector.c 프로젝트: ktakashi/picrin
static pic_value
pic_vec_vector_to_string(pic_state *pic)
{
  pic_vec *vec;
  char *buf;
  int n, start, end, i;
  pic_str *str;

  n = pic_get_args(pic, "v|ii", &vec, &start, &end);

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

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

  buf = pic_malloc(pic, end - start);

  for (i = start; i < end; ++i) {
    pic_assert_type(pic, vec->data[i], char);

    buf[i - start] = pic_char(vec->data[i]);
  }

  str = pic_make_str(pic, buf, end - start);
  pic_free(pic, buf);

  return pic_obj_value(str);
}
예제 #2
0
파일: string.c 프로젝트: simple555a/picrin
static pic_value
pic_str_list_to_string(pic_state *pic)
{
  pic_str *str;
  pic_value list, e, it;
  int i;
  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 {
    i = 0;
    pic_for_each (e, list, it) {
      pic_assert_type(pic, e, char);

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

    str = pic_make_str(pic, buf, i);
  }
예제 #3
0
파일: string.c 프로젝트: simple555a/picrin
static pic_value
pic_str_string_map(pic_state *pic)
{
  struct pic_proc *proc;
  pic_value *argv, vals, val;
  int argc, i, len, j;
  pic_str *str;
  char *buf;

  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]));
  }
  buf = pic_malloc(pic, len);

  pic_try {
    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);
      }
      val = pic_apply_list(pic, proc, vals);

      pic_assert_type(pic, val, char);
      buf[i] = pic_char(val);
    }
    str = pic_make_str(pic, buf, len);
  }
  pic_catch {
    pic_free(pic, buf);
    pic_raise(pic, pic->err);
  }

  pic_free(pic, buf);

  return pic_obj_value(str);
}
예제 #4
0
파일: write.c 프로젝트: koba-e964/picrin
static void
write_char(pic_state *pic, pic_value ch, pic_value port, struct writer_control *p)
{
  char c = pic_char(pic, ch);

  if (p->mode == DISPLAY_MODE) {
    pic_fputc(pic, c, port);
    return;
  }
  switch (c) {
  default: pic_fprintf(pic, port, "#\\%c", c); break;
  case '\a': pic_fprintf(pic, port, "#\\alarm"); break;
  case '\b': pic_fprintf(pic, port, "#\\backspace"); break;
  case 0x7f: pic_fprintf(pic, port, "#\\delete"); break;
  case 0x1b: pic_fprintf(pic, port, "#\\escape"); break;
  case '\n': pic_fprintf(pic, port, "#\\newline"); break;
  case '\r': pic_fprintf(pic, port, "#\\return"); break;
  case ' ': pic_fprintf(pic, port, "#\\space"); break;
  case '\t': pic_fprintf(pic, port, "#\\tab"); break;
  }
}
예제 #5
0
파일: string.c 프로젝트: simple555a/picrin
static pic_value
pic_str_string(pic_state *pic)
{
  int argc, i;
  pic_value *argv;
  pic_str *str;
  char *buf;

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

  buf = pic_malloc(pic, argc);

  for (i = 0; i < argc; ++i) {
    pic_assert_type(pic, argv[i], char);
    buf[i] = pic_char(argv[i]);
  }

  str = pic_make_str(pic, buf, argc);
  pic_free(pic, buf);

  return pic_obj_value(str);
}
예제 #6
0
파일: vm.c 프로젝트: krig/picrin
int
pic_get_args(pic_state *pic, const char *format, ...)
{
  char c;
  int i = 1, argc = pic->ci->argc;
  va_list ap;
  bool opt = false;

  va_start(ap, format);
  while ((c = *format++)) {
    switch (c) {
    default:
      if (argc <= i && ! opt) {
	pic_error(pic, "wrong number of arguments");
      }
      break;
    case '|':
      break;
    case '*':
      break;
    }

    /* in order to run out of all arguments passed to this function
       (i.e. do va_arg for each argument), optional argument existence
       check is done in every case closure */

    if (c == '*')
      break;

    switch (c) {
    case '|':
      opt = true;
      break;
    case 'o': {
      pic_value *p;

      p = va_arg(ap, pic_value*);
      if (i < argc) {
        *p = GET_OPERAND(pic,i);
        i++;
      }
      break;
    }
    case 'f': {
      double *f;

      f = va_arg(ap, double *);
      if (i < argc) {
        pic_value v;

        v = GET_OPERAND(pic, i);
        switch (pic_type(v)) {
        case PIC_TT_FLOAT:
          *f = pic_float(v);
          break;
        case PIC_TT_INT:
          *f = pic_int(v);
          break;
        default:
          pic_error(pic, "pic_get_args: expected float or int");
        }
        i++;
      }
      break;
    }
    case 'F': {
      double *f;
      bool *e;

      f = va_arg(ap, double *);
      e = va_arg(ap, bool *);
      if (i < argc) {
        pic_value v;

        v = GET_OPERAND(pic, i);
        switch (pic_type(v)) {
        case PIC_TT_FLOAT:
          *f = pic_float(v);
          *e = false;
          break;
        case PIC_TT_INT:
          *f = pic_int(v);
          *e = true;
          break;
        default:
          pic_error(pic, "pic_get_args: expected float or int");
        }
        i++;
      }
      break;
    }
    case 'I': {
      int *k;
      bool *e;

      k = va_arg(ap, int *);
      e = va_arg(ap, bool *);
      if (i < argc) {
        pic_value v;

        v = GET_OPERAND(pic, i);
        switch (pic_type(v)) {
        case PIC_TT_FLOAT:
          *k = (int)pic_float(v);
          *e = false;
          break;
        case PIC_TT_INT:
          *k = pic_int(v);
          *e = true;
          break;
        default:
          pic_error(pic, "pic_get_args: expected float or int");
        }
        i++;
      }
      break;
    }
    case 'i': {
      int *k;

      k = va_arg(ap, int *);
      if (i < argc) {
        pic_value v;

        v = GET_OPERAND(pic, i);
        switch (pic_type(v)) {
        case PIC_TT_FLOAT:
          *k = (int)pic_float(v);
          break;
        case PIC_TT_INT:
          *k = pic_int(v);
          break;
        default:
          pic_error(pic, "pic_get_args: expected int");
        }
        i++;
      }
      break;
    }
    case 's': {
      pic_str **str;
      pic_value v;

      str = va_arg(ap, pic_str **);
      if (i < argc) {
        v = GET_OPERAND(pic,i);
        if (pic_str_p(v)) {
          *str = pic_str_ptr(v);
        }
        else {
          pic_error(pic, "pic_get_args: expected string");
        }
        i++;
      }
      break;
    }
    case 'z': {
      pic_value str;
      const char **cstr;

      cstr = va_arg(ap, const char **);
      if (i < argc) {
        str = GET_OPERAND(pic,i);
        if (! pic_str_p(str)) {
          pic_error(pic, "pic_get_args: expected string");
        }
        *cstr = pic_str_cstr(pic_str_ptr(str));
        i++;
      }
      break;
    }
    case 'm': {
      pic_sym *m;
      pic_value v;

      m = va_arg(ap, pic_sym *);
      if (i < argc) {
        v = GET_OPERAND(pic,i);
        if (pic_sym_p(v)) {
          *m = pic_sym(v);
        }
        else {
          pic_error(pic, "pic_get_args: expected symbol");
        }
        i++;
      }
      break;
    }
    case 'v': {
      struct pic_vector **vec;
      pic_value v;

      vec = va_arg(ap, struct pic_vector **);
      if (i < argc) {
        v = GET_OPERAND(pic,i);
        if (pic_vec_p(v)) {
          *vec = pic_vec_ptr(v);
        }
        else {
          pic_error(pic, "pic_get_args: expected vector");
        }
        i++;
      }
      break;
    }
    case 'b': {
      struct pic_blob **b;
      pic_value v;

      b = va_arg(ap, struct pic_blob **);
      if (i < argc) {
        v = GET_OPERAND(pic,i);
        if (pic_blob_p(v)) {
          *b = pic_blob_ptr(v);
        }
        else {
          pic_error(pic, "pic_get_args: expected bytevector");
        }
        i++;
      }
      break;
    }
    case 'c': {
      char *c;
      pic_value v;

      c = va_arg(ap, char *);
      if (i < argc) {
        v = GET_OPERAND(pic,i);
        if (pic_char_p(v)) {
          *c = pic_char(v);
        }
        else {
          pic_error(pic, "pic_get_args: expected char");
        }
        i++;
      }
      break;
    }
    case 'l': {
      struct pic_proc **l;
      pic_value v;

      l = va_arg(ap, struct pic_proc **);
      if (i < argc) {
        v = GET_OPERAND(pic,i);
        if (pic_proc_p(v)) {
          *l = pic_proc_ptr(v);
        }
        else {
          pic_error(pic, "pic_get_args, expected procedure");
        }
        i++;
      }
      break;
    }
    case 'p': {
      struct pic_port **p;
      pic_value v;

      p = va_arg(ap, struct pic_port **);
      if (i < argc) {
        v = GET_OPERAND(pic,i);
        if (pic_port_p(v)) {
          *p = pic_port_ptr(v);
        }
        else {
          pic_error(pic, "pic_get_args, expected port");
        }
        i++;
      }
      break;
    }
    default:
      pic_error(pic, "pic_get_args: invalid argument specifier given");
    }
  }
  if ('*' == c) {
    size_t *n;
    pic_value **argv;

    n = va_arg(ap, size_t *);
    argv = va_arg(ap, pic_value **);
    if (i <= argc) {
      *n = argc - i;
      *argv = &GET_OPERAND(pic, i);
      i = argc;
    }
  }