Commit fa0338c6 authored by Jean-Claude Beaudoin's avatar Jean-Claude Beaudoin
Browse files

Improve reporting of argument count mismatch on function call by stating...

Improve reporting of argument count mismatch on function call by stating actual and expected counts.
parent 826b358a
......@@ -24,15 +24,51 @@
#include "cfun_dispatch.d"
static mkcl_object wrong_num_args(MKCL)
static mkcl_object wrong_num_args_cfun_0(MKCL)
{
mkcl_FEwrong_num_arguments(env, env->function);
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cfun.narg, fun->cfun.narg, 0);
return mk_cl_Cnil;
}
static mkcl_object (wrong_num_args_va)(MKCL, mkcl_narg narg, ...)
static mkcl_object wrong_num_args_cfun_1(MKCL)
{
mkcl_FEwrong_num_arguments(env, env->function);
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cfun.narg, fun->cfun.narg, 1);
return mk_cl_Cnil;
}
static mkcl_object wrong_num_args_cfun_2(MKCL)
{
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cfun.narg, fun->cfun.narg, 2);
return mk_cl_Cnil;
}
static mkcl_object wrong_num_args_cfun_3(MKCL)
{
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cfun.narg, fun->cfun.narg, 3);
return mk_cl_Cnil;
}
static mkcl_object wrong_num_args_cfun_4(MKCL)
{
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cfun.narg, fun->cfun.narg, 4);
return mk_cl_Cnil;
}
static mkcl_object wrong_num_args_cfun_va(MKCL, mkcl_narg narg, ...)
{
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cfun.narg, fun->cfun.narg, narg);
return mk_cl_Cnil;
}
......@@ -49,12 +85,12 @@ mkcl_make_cfun(MKCL, mkcl_objectfn_fixed c_function, mkcl_object name,
2, name, MKCL_MAKE_FIXNUM(narg));
cf = mkcl_alloc_raw_cfun(env);
cf->cfun.f.entry = (((narg < 0) || (narg > 4)) ? dispatch_table[narg] : (mkcl_objectfn) wrong_num_args_va);
cf->cfun.f._[0] = ((narg == 0) ? c_function : (mkcl_objectfn_fixed) wrong_num_args);
cf->cfun.f._[1] = ((narg == 1) ? c_function : (mkcl_objectfn_fixed) wrong_num_args);
cf->cfun.f._[2] = ((narg == 2) ? c_function : (mkcl_objectfn_fixed) wrong_num_args);
cf->cfun.f._[3] = ((narg == 3) ? c_function : (mkcl_objectfn_fixed) wrong_num_args);
cf->cfun.f._[4] = ((narg == 4) ? c_function : (mkcl_objectfn_fixed) wrong_num_args);
cf->cfun.f.entry = (((narg < 0) || (narg > 4)) ? dispatch_table[narg] : (mkcl_objectfn) wrong_num_args_cfun_va);
cf->cfun.f._[0] = ((narg == 0) ? c_function : (mkcl_objectfn_fixed) wrong_num_args_cfun_0);
cf->cfun.f._[1] = ((narg == 1) ? c_function : (mkcl_objectfn_fixed) wrong_num_args_cfun_1);
cf->cfun.f._[2] = ((narg == 2) ? c_function : (mkcl_objectfn_fixed) wrong_num_args_cfun_2);
cf->cfun.f._[3] = ((narg == 3) ? c_function : (mkcl_objectfn_fixed) wrong_num_args_cfun_3);
cf->cfun.f._[4] = ((narg == 4) ? c_function : (mkcl_objectfn_fixed) wrong_num_args_cfun_4);
cf->cfun.old_entry_fixed = c_function;
cf->cfun.name = name;
cf->cfun.block = cblock;
......@@ -213,6 +249,55 @@ mk_si_untrace_closure_creation(MKCL)
static mkcl_object wrong_num_args_cclosure_0(MKCL)
{
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cclosure.narg, fun->cclosure.narg, 0);
return mk_cl_Cnil;
}
static mkcl_object wrong_num_args_cclosure_1(MKCL)
{
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cclosure.narg, fun->cclosure.narg, 1);
return mk_cl_Cnil;
}
static mkcl_object wrong_num_args_cclosure_2(MKCL)
{
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cclosure.narg, fun->cclosure.narg, 2);
return mk_cl_Cnil;
}
static mkcl_object wrong_num_args_cclosure_3(MKCL)
{
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cclosure.narg, fun->cclosure.narg, 3);
return mk_cl_Cnil;
}
static mkcl_object wrong_num_args_cclosure_4(MKCL)
{
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cclosure.narg, fun->cclosure.narg, 4);
return mk_cl_Cnil;
}
static mkcl_object wrong_num_args_cclosure_va(MKCL, mkcl_narg narg, ...)
{
mkcl_object fun = env->function;
mkcl_FEwrong_num_arguments(env, fun, fun->cclosure.narg, fun->cclosure.narg, narg);
return mk_cl_Cnil;
}
mkcl_object
mkcl_make_cclosure(MKCL, mkcl_object producer, mkcl_objectfn_fixed c_function, int narg,
mkcl_index depth, mkcl_object syms_cenv, mkcl_object cenv,
......@@ -221,12 +306,12 @@ mkcl_make_cclosure(MKCL, mkcl_object producer, mkcl_objectfn_fixed c_function, i
mkcl_object cc;
cc = mkcl_alloc_raw_cclosure(env);
cc->cclosure.f.entry = wrong_num_args_va;
cc->cclosure.f._[0] = ((narg == 0) ? c_function : (mkcl_objectfn_fixed) wrong_num_args);
cc->cclosure.f._[1] = ((narg == 1) ? c_function : (mkcl_objectfn_fixed) wrong_num_args);
cc->cclosure.f._[2] = ((narg == 2) ? c_function : (mkcl_objectfn_fixed) wrong_num_args);
cc->cclosure.f._[3] = ((narg == 3) ? c_function : (mkcl_objectfn_fixed) wrong_num_args);
cc->cclosure.f._[4] = ((narg == 4) ? c_function : (mkcl_objectfn_fixed) wrong_num_args);
cc->cclosure.f.entry = wrong_num_args_cclosure_va;
cc->cclosure.f._[0] = ((narg == 0) ? c_function : (mkcl_objectfn_fixed) wrong_num_args_cclosure_0);
cc->cclosure.f._[1] = ((narg == 1) ? c_function : (mkcl_objectfn_fixed) wrong_num_args_cclosure_1);
cc->cclosure.f._[2] = ((narg == 2) ? c_function : (mkcl_objectfn_fixed) wrong_num_args_cclosure_2);
cc->cclosure.f._[3] = ((narg == 3) ? c_function : (mkcl_objectfn_fixed) wrong_num_args_cclosure_3);
cc->cclosure.f._[4] = ((narg == 4) ? c_function : (mkcl_objectfn_fixed) wrong_num_args_cclosure_4);
cc->cclosure.syms_cenv = syms_cenv;
cc->cclosure.block = block;
cc->cclosure.name = mk_cl_Cnil;
......
This diff is collapsed.
......@@ -178,7 +178,7 @@ mkcl_char_eq(MKCL, mkcl_object x, mkcl_object y)
@
/* INV: mkcl_char_eq() checks types of its arguments */
if (narg == 0)
mkcl_FEwrong_num_arguments(env, @'char/=');
mkcl_FEwrong_num_arguments(env, @'char/=', 1, -1, 0);
c = mkcl_va_arg(cs);
for (i = 2; i<=narg; i++) {
mkcl_va_list ds;
......@@ -199,7 +199,7 @@ Lchar_cmp(MKCL, mkcl_narg narg, int s, int t, mkcl_va_list args)
mkcl_object c, d;
if (narg == 0)
mkcl_FEwrong_num_arguments_anonym(env);
mkcl_FEwrong_num_arguments_anonym(env, 1, -1, narg);
c = mkcl_va_arg(args);
for (; --narg; c = d) {
d = mkcl_va_arg(args);
......@@ -272,7 +272,7 @@ mkcl_char_equal(MKCL, mkcl_object x, mkcl_object y)
@
/* INV: mkcl_char_equal() checks the type of its arguments */
if (narg == 0)
mkcl_FEwrong_num_arguments(env, @'char-not-equal');
mkcl_FEwrong_num_arguments(env, @'char-not-equal', 1, -1, narg);
c = mkcl_va_arg(cs);
for (i = 2; i<=narg; i++) {
mkcl_va_list ds;
......@@ -294,7 +294,7 @@ Lchar_compare(MKCL, mkcl_narg narg, int s, int t, mkcl_va_list args)
/* INV: mkcl_char_compare() checks the types of its arguments */
if (narg == 0)
mkcl_FEwrong_num_arguments_anonym(env);
mkcl_FEwrong_num_arguments_anonym(env, 1, -1, narg);
c = mkcl_va_arg(args);
for (; --narg; c = d) {
d = mkcl_va_arg(args);
......
......@@ -707,7 +707,7 @@ put_declaration(void)
}
if (nopt == 0 && !rest_flag && !key_flag) {
put_lineno();
fprintf(out, "\tif (narg!=%d) mkcl_FEwrong_num_arguments(env, MKCL_MAKE_FIXNUM(%d));\n", nreq, function_code);
fprintf(out, "\tif (narg!=%d) mkcl_FEwrong_num_arguments(env, MKCL_MAKE_FIXNUM(%d), %d, %d, narg);\n", nreq, function_code, nreq, nreq);
} else {
simple_varargs = !rest_flag && !key_flag && ((nreq + nopt) < 32);
if (key_flag) {
......@@ -728,11 +728,18 @@ put_declaration(void)
rest_var, rest_var, ((nreq > 0) ? required[nreq-1] : "narg"),
nreq);
put_lineno();
fprintf(out, "\tif (narg < %d", nreq);
if (nopt > 0 && !rest_flag && !key_flag) {
fprintf(out, "|| narg > %d", nreq + nopt);
{
int n_min = nreq;
int n_max = -1;
fprintf(out, "\tif (narg < %d", nreq);
if (nopt > 0 && !rest_flag && !key_flag) {
fprintf(out, "|| narg > %d", nreq + nopt);
n_max = nreq + nopt;
}
fprintf(out, ") mkcl_FEwrong_num_arguments(env, MKCL_MAKE_FIXNUM(%d), %d, %d, narg);\n",
function_code, n_min, n_max);
}
fprintf(out, ") mkcl_FEwrong_num_arguments(env, MKCL_MAKE_FIXNUM(%d));\n", function_code);
for (i = 0; i < nopt; i++) {
put_lineno();
fprintf(out, "\tif (narg > %d) {\n", nreq+i);
......
......@@ -213,18 +213,19 @@ mkcl_FEundefined_function(MKCL, mkcl_object fname)
*************/
void
mkcl_FEwrong_num_arguments(MKCL, mkcl_object fun)
mkcl_FEwrong_num_arguments(MKCL, mkcl_object fun, mkcl_narg min, mkcl_narg max, mkcl_narg narg)
{
if (MKCL_FIXNUMP(fun)) {
fun = (mkcl_object)(mkcl_root_symbols + mkcl_fixnum_to_word(fun));
}
mkcl_FEprogram_error(env, "Wrong number of arguments passed to function ~S", 1, fun);
mkcl_FEprogram_error(env, "Wrong number of arguments passed to function ~S, need ~D to ~D but ~D passed",
4, fun, MKCL_MAKE_FIXNUM(min), MKCL_MAKE_FIXNUM(max), MKCL_MAKE_FIXNUM(narg));
}
void
mkcl_FEwrong_num_arguments_anonym(MKCL)
mkcl_FEwrong_num_arguments_anonym(MKCL, mkcl_narg min, mkcl_narg max, mkcl_narg narg)
{
mkcl_FEprogram_error(env, "Wrong number of arguments passed to an anonymous function", 0);
mkcl_FEprogram_error(env, "Wrong number of arguments passed to an anonymous function, need ~D to ~D but ~D passed", 3, MKCL_MAKE_FIXNUM(min), MKCL_MAKE_FIXNUM(max), MKCL_MAKE_FIXNUM(narg));
}
void
......
......@@ -445,7 +445,7 @@ get_spec_vector(MKCL, mkcl_object frame, mkcl_object gf)
if (spec_no >= vector->vector.dim)
return MKCL_OBJNULL; /* cache key size overflow. JCB */
if (spec_position >= narg)
mkcl_FEwrong_num_arguments(env, gf);
mkcl_FEwrong_num_arguments(env, gf, spec_position + 1, -1, narg);
{
const mkcl_object arg = args[spec_position];
......
......@@ -540,7 +540,7 @@ mkcl_interpret(MKCL, mkcl_object frame, mkcl_object lex_env, mkcl_object bytecod
if ( func_narg < 0 )
reg0 = mkcl_APPLY(env, narg, reg0, frame_aux.base);
else if ( narg != func_narg )
mkcl_FEwrong_num_arguments(env, reg0);
mkcl_FEwrong_num_arguments(env, reg0, func_narg, func_narg, narg);
else if ( narg < MKCL_MAX_FAST_FUNC_DISPATCH )
reg0 = mkcl_APPLY_fixed(env, narg, reg0->cfun.f._[narg], frame_aux.base);
else
......@@ -608,7 +608,8 @@ mkcl_interpret(MKCL, mkcl_object frame, mkcl_object lex_env, mkcl_object bytecod
*/
CASE(OP_POPREQ); {
if (frame_index >= frame->frame.size) {
mkcl_FEwrong_num_arguments(env, bytecode->bytecode.name);
mkcl_FEwrong_num_arguments(env, bytecode->bytecode.name,
frame->frame.size, frame->frame.size, frame_index);
}
reg0 = frame->frame.base[frame_index++];
THREAD_NEXT;
......
......@@ -151,7 +151,7 @@ extern inline mkcl_object mk_cl_cdr(MKCL, mkcl_object x);
mkcl_object head;
@
if (narg == 0)
mkcl_FEwrong_num_arguments(env, @'list*');
mkcl_FEwrong_num_arguments(env, @'list*', 1, -1, narg);
head = mkcl_va_arg(args);
if (--narg) {
mkcl_object tail = head = mkcl_list1(env, head);
......@@ -1095,7 +1095,7 @@ mkcl_adjoin(MKCL, mkcl_object item, mkcl_object list)
if (narg == 2)
output = mkcl_adjoin(env, item, list);
else if (narg < 2)
mkcl_FEwrong_num_arguments(env, @'adjoin');
mkcl_FEwrong_num_arguments(env, @'adjoin', 2, -1, narg);
else
{
output = @si::member1(env, item, list, test, test_not, key);
......
......@@ -736,8 +736,8 @@ extern "C" {
extern MKCL_API void mkcl_FEwrong_type_argument(MKCL, mkcl_object type, mkcl_object value) mkcl_noreturn;
extern MKCL_API void mkcl_FEnot_fixnum_type(MKCL, mkcl_object value) mkcl_noreturn;
extern MKCL_API void mkcl_FEnot_codeblock_type(MKCL, mkcl_object value) mkcl_noreturn;
extern MKCL_API void mkcl_FEwrong_num_arguments(MKCL, mkcl_object fun) mkcl_noreturn;
extern MKCL_API void mkcl_FEwrong_num_arguments_anonym(MKCL) mkcl_noreturn;
extern MKCL_API void mkcl_FEwrong_num_arguments(MKCL, mkcl_object fun, mkcl_narg min, mkcl_narg max, mkcl_narg narg) mkcl_noreturn;
extern MKCL_API void mkcl_FEwrong_num_arguments_anonym(MKCL, mkcl_narg min, mkcl_narg max, mkcl_narg narg) mkcl_noreturn;
extern MKCL_API void mkcl_FEunbound_variable(MKCL, mkcl_object sym) mkcl_noreturn;
extern MKCL_API void mkcl_FEinvalid_macro_call(MKCL, mkcl_object obj) mkcl_noreturn;
extern MKCL_API void mkcl_FEinvalid_variable(MKCL, const char *s, mkcl_object obj) mkcl_noreturn;
......
......@@ -391,7 +391,7 @@ extern "C" {
#endif
#define mkcl_va_end(a) va_end(a[0].args)
#define mkcl_check_arg(e,n) do { if (narg != (n)) mkcl_FEwrong_num_arguments_anonym(e);} while(0)
#define mkcl_check_arg(e,n) do { if (narg != (n)) mkcl_FEwrong_num_arguments_anonym(e, n, n, narg);} while(0)
/***********************
* RETURN VALUES STACK
......
......@@ -771,7 +771,7 @@ mkcl_negate(MKCL, mkcl_object x)
@
/* INV: type check is in mkcl_divide() */
if (narg == 0)
mkcl_FEwrong_num_arguments(env, @'/');
mkcl_FEwrong_num_arguments(env, @'/', 1, -1, narg);
if (narg == 1)
{ mkcl_va_end(nums); @(return mkcl_divide(env, MKCL_MAKE_FIXNUM(1), num)); }
while (--narg)
......
......@@ -395,7 +395,7 @@ mkcl_number_compare(MKCL, mkcl_object x, mkcl_object y)
int i, j;
@
if (narg == 0)
mkcl_FEwrong_num_arguments_anonym(env);
mkcl_FEwrong_num_arguments_anonym(env, 1, -1, narg);
numi = mkcl_va_arg(nums);
for (i = 2; i<=narg; i++) {
mkcl_va_list numb;
......@@ -416,7 +416,7 @@ monotonic(MKCL, int s, int t, int narg, mkcl_va_list nums)
mkcl_object c, d;
if (narg == 0)
mkcl_FEwrong_num_arguments_anonym(env);
mkcl_FEwrong_num_arguments_anonym(env, 1, -1, narg);
/* INV: type check occurs in mkcl_number_compare() */
for (c = mkcl_va_arg(nums); --narg; c = d) {
d = mkcl_va_arg(nums);
......
......@@ -1047,7 +1047,7 @@ string_compare(MKCL, mkcl_narg narg, int sign1, int sign2, int case_sensitive, m
#define start2p KEY_VARS[6]
mkcl_object KEY_VARS[8];
if (narg < 2) mkcl_FEwrong_num_arguments_anonym(env);
if (narg < 2) mkcl_FEwrong_num_arguments_anonym(env, 2, -1, narg);
KEYS[0]=@':start1';
KEYS[1]=@':end1';
KEYS[2]=@':start2';
......@@ -1300,7 +1300,7 @@ string_case(MKCL, mkcl_narg narg, mkcl_casefun casefun, mkcl_va_list ARGS)
mkcl_object conv;
mkcl_object KEY_VARS[4];
if (narg < 1) mkcl_FEwrong_num_arguments_anonym(env);
if (narg < 1) mkcl_FEwrong_num_arguments_anonym(env, 1, -1, narg);
KEYS[0]=@':start';
KEYS[1]=@':end';
mkcl_parse_key(env, ARGS, 2, KEYS, KEY_VARS, NULL, FALSE, FALSE);
......@@ -1386,7 +1386,7 @@ nstring_case(MKCL, mkcl_narg narg, mkcl_object fun, mkcl_casefun casefun, mkcl_v
#define startp KEY_VARS[2]
mkcl_object KEY_VARS[4];
if (narg < 1) mkcl_FEwrong_num_arguments_anonym(env);
if (narg < 1) mkcl_FEwrong_num_arguments_anonym(env, 1, -1, narg);
KEYS[0]=@':start';
KEYS[1]=@':end';
mkcl_parse_key(env, ARGS, 2, KEYS, KEY_VARS, NULL, FALSE, FALSE);
......
......@@ -1781,7 +1781,7 @@ mk_mt_thread_preset(MKCL, mkcl_narg narg, mkcl_object thread, mkcl_object functi
{
mkcl_call_stack_check(env);
if (narg < 2)
mkcl_FEwrong_num_arguments(env, @'mt::thread-preset');
mkcl_FEwrong_num_arguments(env, @'mt::thread-preset', 2, -1, narg);
mkcl_assert_type_thread(env, thread);
if (thread->thread.detached)
......@@ -3119,7 +3119,7 @@ mk_mt_thread_run_function(MKCL, mkcl_narg narg, mkcl_object name, mkcl_object fu
mkcl_call_stack_check(env);
if (narg < 2)
mkcl_FEwrong_num_arguments(env, @'mt::thread-run-function');
mkcl_FEwrong_num_arguments(env, @'mt::thread-run-function', 2, -1, narg);
mkcl_va_start(env, args, function, narg, 2);
mkcl_object rest = mkcl_grab_rest_args(env, args, FALSE);
......
......@@ -333,8 +333,8 @@
(nth n *text-for-lexical-level*) x))
(push x args))))))
(unless (<= minarg narg maxarg)
(error "Wrong number of arguments for function ~S"
(or fun-lisp-name 'ANONYMOUS)))
(error "Wrong number of arguments for function ~S, need ~D to ~D but ~D passed"
(or fun-lisp-name 'ANONYMOUS) minarg maxarg narg))
(when (fun-needs-narg fun)
(push narg args))
(wt-call fun-c-name args fun-lisp-name env syms-env fun)))
......
......@@ -356,14 +356,29 @@ The function thus belongs to the type of functions that mkcl_make_cfun accepts."
(incf *inline-blocks*)
(if (and use-narg (not varargs))
(wt-nl "if(narg!=" nreq ") "
(if fname "mkcl_FEwrong_num_arguments(env, this_func);" "mkcl_FEwrong_num_arguments_anonym(env);"))
(if fname
"mkcl_FEwrong_num_arguments(env, this_func, "
"mkcl_FEwrong_num_arguments_anonym(env, ")
nreq ", " nreq
", narg);"
)
(when varargs
(when requireds
(wt-nl "if(narg<" nreq ") "
(if fname "mkcl_FEwrong_num_arguments(env, this_func);" "mkcl_FEwrong_num_arguments_anonym(env);")))
(if fname
"mkcl_FEwrong_num_arguments(env, this_func, "
"mkcl_FEwrong_num_arguments_anonym(env, ")
nreq ", " (if (or rest key-flag) "-1" (+ nreq nopt))
", narg);"
))
(unless (or rest key-flag)
(wt-nl "if(narg>" (+ nreq nopt) ") "
(if fname "mkcl_FEwrong_num_arguments(env, this_func);" "mkcl_FEwrong_num_arguments_anonym(env);")))))
(if fname
"mkcl_FEwrong_num_arguments(env, this_func, "
"mkcl_FEwrong_num_arguments_anonym(env, ")
nreq ", " (+ nreq nopt)
", narg);"
))))
(wt-nl "{"))
;; If the number of required arguments exceeds the number of variables we
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment