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

Merge pull request #249 from picrin-scheme/better-error-message2 

Better error message2
This commit is contained in:
Yuichi Nishiwaki 2015-02-04 23:58:50 +09:00
parent a80f4834dc 06a2b09e69
commit 9ee2227d06
2 changed files with 216 additions and 241 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
extlib/benz/codegen.c
View File

@ -555,10 +555,14 @@ analyze_quote(analyze_state *state, pic_value obj)
return pic_list2(pic, pic_obj_value(pic->sQUOTE), pic_list_ref(pic, obj, 1));
}
#define ARGC_ASSERT_GE(n) do { \
if (pic_length(pic, obj) < (n) + 1) { \
pic_errorf(pic, "wrong number of arguments"); \
} \
#define ARGC_ASSERT_GE(n, name) do { \
if (pic_length(pic, obj) < (n) + 1) { \
pic_errorf(pic, \
#name ": wrong number of arguments (%d for at least %d)", \
pic_length(pic, obj) - 1, \
n); \
} \
} while (0)
#define FOLD_ARGS(sym) do { \
@ -569,13 +573,14 @@ analyze_quote(analyze_state *state, pic_value obj)
} \
} while (0)
static pic_value
analyze_add(analyze_state *state, pic_value obj, bool tailpos)
{
pic_state *pic = state->pic;
pic_value args, arg, it;
ARGC_ASSERT_GE(0);
ARGC_ASSERT_GE(0, "+");
switch (pic_length(pic, obj)) {
case 1:
return pic_list2(pic, pic_obj_value(pic->sQUOTE), pic_int_value(0));
@ -594,7 +599,7 @@ analyze_sub(analyze_state *state, pic_value obj)
pic_state *pic = state->pic;
pic_value args, arg, it;
ARGC_ASSERT_GE(1);
ARGC_ASSERT_GE(1, "-");
switch (pic_length(pic, obj)) {
case 2:
return pic_list2(pic, pic_obj_value(pic->sMINUS),
@ -612,7 +617,7 @@ analyze_mul(analyze_state *state, pic_value obj, bool tailpos)
pic_state *pic = state->pic;
pic_value args, arg, it;
ARGC_ASSERT_GE(0);
ARGC_ASSERT_GE(0, "*");
switch (pic_length(pic, obj)) {
case 1:
return pic_list2(pic, pic_obj_value(pic->sQUOTE), pic_int_value(1));
@ -631,7 +636,7 @@ analyze_div(analyze_state *state, pic_value obj)
pic_state *pic = state->pic;
pic_value args, arg, it;
ARGC_ASSERT_GE(1);
ARGC_ASSERT_GE(1, "/");
switch (pic_length(pic, obj)) {
case 2:
args = pic_cdr(pic, obj);
@ -688,7 +693,7 @@ analyze_call_with_values(analyze_state *state, pic_value obj, bool tailpos)
pic_sym *call;
if (pic_length(pic, obj) != 3) {
pic_errorf(pic, "wrong number of arguments");
pic_errorf(pic, "call-with-values: wrong number of arguments (%d for 2)", pic_length(pic, obj) - 1);
}
if (! tailpos) {
@ -701,10 +706,11 @@ analyze_call_with_values(analyze_state *state, pic_value obj, bool tailpos)
return pic_list3(pic, pic_obj_value(call), prod, cnsm);
}
#define ARGC_ASSERT(n) do { \
if (pic_length(pic, obj) != (n) + 1) { \
pic_errorf(pic, "wrong number of arguments"); \
} \
#define ARGC_ASSERT(n, name) do { \
if (pic_length(pic, obj) != (n) + 1) { \
pic_errorf(pic, #name ": wrong number of arguments (%d for %d)", \
pic_length(pic, obj) - 1, n); \
} \
} while (0)
#define ARGC_ASSERT_WITH_FALLBACK(n) do { \
@ -724,6 +730,7 @@ analyze_call_with_values(analyze_state *state, pic_value obj, bool tailpos)
analyze(state, pic_list_ref(pic, obj, 1), false), \
analyze(state, pic_list_ref(pic, obj, 2), false))
static pic_value
analyze_node(analyze_state *state, pic_value obj, bool tailpos)
{
@ -763,27 +770,27 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
return analyze_quote(state, obj);
}
else if (sym == state->rCONS) {
ARGC_ASSERT(2);
ARGC_ASSERT(2, "cons");
return CONSTRUCT_OP2(pic->sCONS);
}
else if (sym == state->rCAR) {
ARGC_ASSERT(1);
ARGC_ASSERT(1, "car");
return CONSTRUCT_OP1(pic->sCAR);
}
else if (sym == state->rCDR) {
ARGC_ASSERT(1);
ARGC_ASSERT(1, "cdr");
return CONSTRUCT_OP1(pic->sCDR);
}
else if (sym == state->rNILP) {
ARGC_ASSERT(1);
ARGC_ASSERT(1, "nil?");
return CONSTRUCT_OP1(pic->sNILP);
}
else if (sym == state->rSYMBOLP) {
ARGC_ASSERT(1);
ARGC_ASSERT(1, "symbol?");
return CONSTRUCT_OP1(pic->sSYMBOLP);
}
else if (sym == state->rPAIRP) {
ARGC_ASSERT(1);
ARGC_ASSERT(1, "pair?");
return CONSTRUCT_OP1(pic->sPAIRP);
}
else if (sym == state->rADD) {
@ -819,7 +826,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
return CONSTRUCT_OP2(pic->sGE);
}
else if (sym == state->rNOT) {
ARGC_ASSERT(1);
ARGC_ASSERT(1, "not");
return CONSTRUCT_OP1(pic->sNOT);
}
else if (sym == state->rVALUES) {

410
extlib/benz/vm.c
View File

@ -58,64 +58,83 @@ int
pic_get_args(pic_state *pic, const char *format, ...)
{
char c;
int i = 1, argc = pic->ci->argc;
size_t paramc, optc, min;
size_t i , argc = pic->ci->argc - 1;
va_list ap;
bool opt = false;
bool rest = false, opt = false;
va_start(ap, format);
while ((c = *format++)) {
switch (c) {
default:
if (argc <= i && ! opt) {
pic_errorf(pic, "wrong number of arguments");
}
break;
case '|':
break;
case '*':
break;
}
/* paramc: required args count as scheme proc
optc: optional args count as scheme proc
argc: passed args count as scheme proc
vargc: args count passed to this function
*/
/* 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 '|':
/* check nparams first */
for (paramc = 0, c = *format; c; c = format[++paramc]) {
if (c == '|') {
opt = true;
break;
}
else if (c == '*') {
rest = true;
break;
}
}
for (optc = 0; opt && c; c = format[paramc + opt + ++optc]) {
if (c == '*') {
rest = true;
break;
}
}
/* '|' should be followed by at least 1 char */
assert(opt <= optc);
/* '*' should not be followed by any char */
assert(format[paramc + opt + optc + rest] == '\0');
/* check argc. */
if (argc < paramc || (paramc + optc < argc && ! rest)) {
pic_errorf(pic, "%s: wrong number of arguments (%d for %s%d)",
pic_symbol_name(pic, pic_proc_name(pic_proc_ptr(GET_OPERAND(pic, 0)))) ,
argc,
rest? "at least " : "",
paramc);
}
/* start dispatching */
va_start(ap, format);
min = paramc + optc < argc ? paramc + optc : argc;
for(i = 1; i < min + 1; i++) {
c = *format++;
/* skip '|' if exists. This is always safe because of assert and argc check */
c = c == '|' ? *format++ : c;
switch (c) {
case 'o': {
pic_value *p;
p = va_arg(ap, pic_value*);
if (i < argc) {
*p = GET_OPERAND(pic,i);
i++;
}
*p = GET_OPERAND(pic,i);
break;
}
case 'f': {
double *f;
f = va_arg(ap, double *);
if (i < argc) {
pic_value v;
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_errorf(pic, "pic_get_args: expected float or int, but got ~s", v);
}
i++;
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_errorf(pic, "pic_get_args: expected float or int, but got ~s", v);
}
break;
}
@ -125,23 +144,20 @@ pic_get_args(pic_state *pic, const char *format, ...)
f = va_arg(ap, double *);
e = va_arg(ap, bool *);
if (i < argc) {
pic_value v;
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_errorf(pic, "pic_get_args: expected float or int, but got ~s", v);
}
i++;
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_errorf(pic, "pic_get_args: expected float or int, but got ~s", v);
}
break;
}
@ -151,23 +167,20 @@ pic_get_args(pic_state *pic, const char *format, ...)
k = va_arg(ap, int *);
e = va_arg(ap, bool *);
if (i < argc) {
pic_value v;
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_errorf(pic, "pic_get_args: expected float or int, but got ~s", v);
}
i++;
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_errorf(pic, "pic_get_args: expected float or int, but got ~s", v);
}
break;
}
@ -175,21 +188,18 @@ pic_get_args(pic_state *pic, const char *format, ...)
int *k;
k = va_arg(ap, int *);
if (i < argc) {
pic_value v;
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_errorf(pic, "pic_get_args: expected int, but got ~s", v);
}
i++;
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;
}
@ -197,30 +207,27 @@ pic_get_args(pic_state *pic, const char *format, ...)
size_t *k;
k = va_arg(ap, size_t *);
if (i < argc) {
pic_value v;
int x;
size_t s;
pic_value v;
int x;
size_t s;
v = GET_OPERAND(pic, i);
switch (pic_type(v)) {
case PIC_TT_INT:
x = pic_int(v);
if (x < 0) {
pic_errorf(pic, "pic_get_args: expected non-negative int, but got ~s", v);
}
s = (size_t)x;
if (sizeof(unsigned) > sizeof(size_t)) {
if (x != (int)s) {
pic_errorf(pic, "pic_get_args: int unrepresentable with size_t ~s", v);
}
}
*k = (size_t)x;
break;
default:
pic_errorf(pic, "pic_get_args: expected int, but got ~s", v);
v = GET_OPERAND(pic, i);
switch (pic_type(v)) {
case PIC_TT_INT:
x = pic_int(v);
if (x < 0) {
pic_errorf(pic, "pic_get_args: expected non-negative int, but got ~s", v);
}
i++;
s = (size_t)x;
if (sizeof(unsigned) > sizeof(size_t)) {
if (x != (int)s) {
pic_errorf(pic, "pic_get_args: int unrepresentable with size_t ~s", v);
}
}
*k = (size_t)x;
break;
default:
pic_errorf(pic, "pic_get_args: expected int, but got ~s", v);
}
break;
}
@ -229,15 +236,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
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_errorf(pic, "pic_get_args: expected string, but got ~s", v);
}
i++;
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;
}
@ -246,14 +250,11 @@ pic_get_args(pic_state *pic, const char *format, ...)
pic_value v;
cstr = va_arg(ap, const char **);
if (i < argc) {
v = GET_OPERAND(pic,i);
if (! pic_str_p(v)) {
pic_errorf(pic, "pic_get_args: expected string, but got ~s", v);
}
*cstr = pic_str_cstr(pic_str_ptr(v));
i++;
v = GET_OPERAND(pic,i);
if (! pic_str_p(v)) {
pic_errorf(pic, "pic_get_args: expected string, but got ~s", v);
}
*cstr = pic_str_cstr(pic_str_ptr(v));
break;
}
case 'm': {
@ -261,15 +262,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
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_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args: expected symbol, but got ~s", v);
}
i++;
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;
}
@ -278,15 +276,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
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_errorf(pic, "pic_get_args: expected vector, but got ~s", v);
}
i++;
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;
}
@ -295,15 +290,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
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_errorf(pic, "pic_get_args: expected bytevector, but got ~s", v);
}
i++;
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;
}
@ -312,15 +304,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
pic_value v;
k = va_arg(ap, char *);
if (i < argc) {
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);
}
i++;
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;
}
@ -329,15 +318,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
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_errorf(pic, "pic_get_args, expected procedure, but got ~s", v);
}
i++;
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;
}
@ -346,15 +332,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
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_errorf(pic, "pic_get_args, expected port, but got ~s", v);
}
i++;
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;
}
@ -363,15 +346,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
pic_value v;
d = va_arg(ap, struct pic_dict **);
if (i < argc) {
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);
}
i++;
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;
}
@ -380,15 +360,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
pic_value v;
r = va_arg(ap, struct pic_record **);
if (i < argc) {
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);
}
i++;
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;
}
@ -397,15 +374,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
pic_value v;
e = va_arg(ap, struct pic_error **);
if (i < argc) {
v = GET_OPERAND(pic,i);
if (pic_error_p(v)) {
*e = pic_error_ptr(v);
}
else {
pic_errorf(pic, "pic_get_args, expected error");
}
i++;
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;
}
@ -413,23 +387,17 @@ pic_get_args(pic_state *pic, const char *format, ...)
pic_errorf(pic, "pic_get_args: invalid argument specifier '%c' given", c);
}
}
if ('*' == c) {
size_t *n;
pic_value **argv;
if (rest) {
size_t *n;
pic_value **argv;
n = va_arg(ap, size_t *);
argv = va_arg(ap, pic_value **);
if (i <= argc) {
*n = (size_t)(argc - i);
n = va_arg(ap, size_t *);
argv = va_arg(ap, pic_value **);
*n = (size_t)(argc - (i - 1));
*argv = &GET_OPERAND(pic, i);
i = argc;
}
}
else if (argc > i) {
pic_errorf(pic, "wrong number of arguments");
}
va_end(ap);
return i - 1;
return argc;
}
void
@ -915,7 +883,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
if (ci->argc != irep->argc) {
if (! (irep->varg && ci->argc >= irep->argc)) {
pic_errorf(pic, "wrong number of arguments (%d for %d%s)", ci->argc - 1, irep->argc - 1, (irep->varg ? "+" : ""));
pic_errorf(pic, "wrong number of arguments (%d for %s%d)", ci->argc - 1, (irep->varg ? "at least " : ""), irep->argc - 1);
}
}
/* prepare rest args */