conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'cleanup-pic_get_args'

This commit is contained in:
Yuichi Nishiwaki 2015-08-26 22:40:35 +09:00
parent ee2a4b92f5 333813d0ba
commit 69d9a212ed
1 changed files with 56 additions and 233 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

289
extlib/benz/vm.c
View File

@ -26,12 +26,12 @@ pic_get_proc(pic_state *pic)
* I int *, bool * int with exactness * I int *, bool * int with exactness
* f double * float * f double * float
* F double *, bool * float with exactness * F double *, bool * float with exactness
* s pic_str ** string object * c char * char
* z char ** c string * z char ** c string
* s pic_str ** string object
* m pic_sym ** symbol * m pic_sym ** symbol
* v pic_vec ** vector object * v pic_vec ** vector object
* b pic_blob ** bytevector object * b pic_blob ** bytevector object
* c char * char
* l struct pic_proc ** lambda object * l struct pic_proc ** lambda object
* p struct pic_port ** port object * p struct pic_port ** port object
* d struct pic_dict ** dictionary object * d struct pic_dict ** dictionary object
@ -102,244 +102,67 @@ pic_get_args(pic_state *pic, const char *format, ...)
*p = GET_OPERAND(pic,i); *p = GET_OPERAND(pic,i);
break; break;
} }
case 'f': {
double *f;
pic_value v;
f = va_arg(ap, double *); #define NUM_CASE(c1, c2, ctype) \
case c1: case c2: { \
ctype *n; \
bool *e, dummy; \
pic_value v; \
\
n = va_arg(ap, ctype *); \
e = (c == c2 ? va_arg(ap, bool *) : &dummy); \
\
v = GET_OPERAND(pic, i); \
switch (pic_type(v)) { \
case PIC_TT_FLOAT: \
*n = pic_float(v); \
*e = false; \
break; \
case PIC_TT_INT: \
*n = pic_int(v); \
*e = true; \
break; \
default: \
pic_errorf(pic, "pic_get_args: expected float or int, but got ~s", v); \
} \
break; \
}
v = GET_OPERAND(pic, i); NUM_CASE('i', 'I', int)
switch (pic_type(v)) { NUM_CASE('f', 'F', double)
case PIC_TT_FLOAT:
*f = pic_float(v);
break;
case PIC_TT_INT:
*f = pic_int(v);
break;
default:
pic_errorf(pic, "pic_get_args: expected float or int, but got ~s", v);
}
break;
}
case 'F': {
double *f;
bool *e;
pic_value v;
f = va_arg(ap, double *); #define VAL_CASE(c, type, ctype, conv) \
e = va_arg(ap, bool *); case c: { \
ctype *ptr; \
pic_value v; \
\
ptr = va_arg(ap, ctype *); \
v = GET_OPERAND(pic, i); \
if (pic_## type ##_p(v)) { \
*ptr = conv; \
} \
else { \
pic_errorf(pic, "pic_get_args: expected " #type ", but got ~s", v); \
} \
break; \
}
v = GET_OPERAND(pic, i); VAL_CASE('c', char, char, pic_char(v))
switch (pic_type(v)) { VAL_CASE('z', str, const char *, pic_str_cstr(pic, pic_str_ptr(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_errorf(pic, "pic_get_args: expected float or int, but got ~s", v);
}
break;
}
case 'I': {
int *k;
bool *e;
pic_value v;
k = va_arg(ap, int *); #define PTR_CASE(c, type, ctype) \
e = va_arg(ap, bool *); VAL_CASE(c, type, ctype, pic_## type ##_ptr(v))
v = GET_OPERAND(pic, i); PTR_CASE('s', str, pic_str *)
switch (pic_type(v)) { PTR_CASE('m', sym, pic_sym *)
case PIC_TT_FLOAT: PTR_CASE('v', vec, pic_vec *)
*k = (int)pic_float(v); PTR_CASE('b', blob, pic_blob *)
*e = false; PTR_CASE('l', proc, struct pic_proc *)
break; PTR_CASE('p', port, struct pic_port *)
case PIC_TT_INT: PTR_CASE('d', dict, struct pic_dict *)
*k = pic_int(v); PTR_CASE('r', record, struct pic_record *)
*e = true; PTR_CASE('e', error, struct pic_error *)
break;
default:
pic_errorf(pic, "pic_get_args: expected float or int, but got ~s", v);
}
break;
}
case 'i': {
int *k;
pic_value v;
k = va_arg(ap, int *);
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_errorf(pic, "pic_get_args: expected int, but got ~s", v);
}
break;
}
case 's': {
pic_str **str;
pic_value v;
str = va_arg(ap, pic_str **);
v = GET_OPERAND(pic,i);
if (pic_str_p(v)) {
*str = pic_str_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args: expected string, but got ~s", v);
}
break;
}
case 'z': {
const char **cstr;
pic_value v;
cstr = va_arg(ap, const char **);
v = GET_OPERAND(pic,i);
if (pic_str_p(v)) {
*cstr = pic_str_cstr(pic, pic_str_ptr(v));
}
else {
pic_errorf(pic, "pic_get_args: expected string, but got ~s", v);
}
break;
}
case 'm': {
pic_sym **m;
pic_value v;
m = va_arg(ap, pic_sym **);
v = GET_OPERAND(pic,i);
if (pic_sym_p(v)) {
*m = pic_sym_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args: expected symbol, but got ~s", v);
}
break;
}
case 'v': {
struct pic_vector **vec;
pic_value v;
vec = va_arg(ap, struct pic_vector **);
v = GET_OPERAND(pic,i);
if (pic_vec_p(v)) {
*vec = pic_vec_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args: expected vector, but got ~s", v);
}
break;
}
case 'b': {
struct pic_blob **b;
pic_value v;
b = va_arg(ap, struct pic_blob **);
v = GET_OPERAND(pic,i);
if (pic_blob_p(v)) {
*b = pic_blob_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args: expected bytevector, but got ~s", v);
}
break;
}
case 'c': {
char *k;
pic_value v;
k = va_arg(ap, char *);
v = GET_OPERAND(pic,i);
if (pic_char_p(v)) {
*k = pic_char(v);
}
else {
pic_errorf(pic, "pic_get_args: expected char, but got ~s", v);
}
break;
}
case 'l': {
struct pic_proc **l;
pic_value v;
l = va_arg(ap, struct pic_proc **);
v = GET_OPERAND(pic,i);
if (pic_proc_p(v)) {
*l = pic_proc_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args, expected procedure, but got ~s", v);
}
break;
}
case 'p': {
struct pic_port **p;
pic_value v;
p = va_arg(ap, struct pic_port **);
v = GET_OPERAND(pic,i);
if (pic_port_p(v)) {
*p = pic_port_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args, expected port, but got ~s", v);
}
break;
}
case 'd': {
struct pic_dict **d;
pic_value v;
d = va_arg(ap, struct pic_dict **);
v = GET_OPERAND(pic,i);
if (pic_dict_p(v)) {
*d = pic_dict_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args, expected dictionary, but got ~s", v);
}
break;
}
case 'r': {
struct pic_record **r;
pic_value v;
r = va_arg(ap, struct pic_record **);
v = GET_OPERAND(pic,i);
if (pic_record_p(v)) {
*r = pic_record_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args: expected record, but got ~s", v);
}
break;
}
case 'e': {
struct pic_error **e;
pic_value v;
e = va_arg(ap, struct pic_error **);
v = GET_OPERAND(pic,i);
if (pic_error_p(v)) {
*e = pic_error_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args, expected error");
}
break;
}
default: default:
pic_errorf(pic, "pic_get_args: invalid argument specifier '%c' given", c); pic_errorf(pic, "pic_get_args: invalid argument specifier '%c' given", c);
} }