Commit 6f3243db authored by Paul Pogonyshev's avatar Paul Pogonyshev Committed by Eli Zaretskii
Browse files

Implement 'func-arity'

* src/eval.c (Ffunc_arity, lambda_arity): New functions.
* src/bytecode.c (get_byte_code_arity): New function.
* src/lisp.h (get_byte_code_arity): Add prototype.

* doc/lispref/functions.texi (What Is a Function): Document
'func-arity'.

* etc/NEWS: Mention 'func-arity'.

* test/src/fns-tests.el (fns-tests-func-arity): New test set.
parent 368b9bb4
......@@ -141,6 +141,37 @@ This function returns @code{t} if @var{object} is any kind of
function, i.e., can be passed to @code{funcall}. Note that
@code{functionp} returns @code{t} for symbols that are function names,
and returns @code{nil} for special forms.
@end defun
It is also possible to find out how many arguments an arbitrary
function expects:
@defun func-arity function
This function provides information about the argument list of the
specified @var{function}. The returned value is a cons cell of the
form @w{@code{(@var{min} . @var{max})}}, where @var{min} is the
minimum number of arguments, and @var{max} is either the maximum
number of arguments, or the symbol @code{many} for functions with
@code{&rest} arguments, or the symbol @code{unevalled} if
@var{function} is a special form.
Note that this function might return inaccurate results in some
situations, such as the following:
@itemize @minus
@item
Functions defined using @code{apply-partially} (@pxref{Calling
Functions, apply-partially}).
@item
Functions that are advised using @code{advice-add} (@pxref{Advising
Named Functions}).
@item
Functions that determine the argument list dynamically, as part of
their code.
@end itemize
@end defun
@noindent
......@@ -176,12 +207,9 @@ function. For example:
@end defun
@defun subr-arity subr
This function provides information about the argument list of a
primitive, @var{subr}. The returned value is a pair
@code{(@var{min} . @var{max})}. @var{min} is the minimum number of
args. @var{max} is the maximum number or the symbol @code{many}, for a
function with @code{&rest} arguments, or the symbol @code{unevalled} if
@var{subr} is a special form.
This works like @code{func-arity}, but only for built-in functions and
without symbol indirection. It signals an error for non-built-in
functions. We recommend to use @code{func-arity} instead.
@end defun
@node Lambda Expressions
......
......@@ -181,6 +181,13 @@ a new window when opening man pages when there's already one, use
(inhibit-same-window . nil)
(mode . Man-mode))))
+++
** New function 'func-arity' returns information about the argument list
of an arbitrary function.
This is a generalization of 'subr-arity' for functions that are not
built-in primitives. We recommend using this new function instead of
'subr-arity'.
+++
** 'parse-partial-sexp' state has a new element. Element 10 is
non-nil when the last character scanned might be the first character
......
......@@ -1987,6 +1987,24 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
return result;
}
/* `args_template' has the same meaning as in exec_byte_code() above. */
Lisp_Object
get_byte_code_arity (Lisp_Object args_template)
{
if (INTEGERP (args_template))
{
ptrdiff_t at = XINT (args_template);
bool rest = (at & 128) != 0;
int mandatory = at & 127;
ptrdiff_t nonrest = at >> 8;
return Fcons (make_number (mandatory),
rest ? Qmany : make_number (nonrest));
}
else
error ("Unknown args template!");
}
void
syms_of_bytecode (void)
{
......
......@@ -90,6 +90,7 @@ union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE;
static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, ptrdiff_t);
static Lisp_Object lambda_arity (Lisp_Object);
static Lisp_Object
specpdl_symbol (union specbinding *pdl)
......@@ -2934,6 +2935,115 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
return unbind_to (count, val);
}
DEFUN ("func-arity", Ffunc_arity, Sfunc_arity, 1, 1, 0,
doc: /* Return minimum and maximum number of args allowed for FUNCTION.
FUNCTION must be a function of some kind.
The returned value is a cons cell (MIN . MAX). MIN is the minimum number
of args. MAX is the maximum number, or the symbol `many', for a
function with `&rest' args, or `unevalled' for a special form. */)
(Lisp_Object function)
{
Lisp_Object original;
Lisp_Object funcar;
Lisp_Object result;
short minargs, maxargs;
original = function;
retry:
/* Optimize for no indirection. */
function = original;
if (SYMBOLP (function) && !NILP (function)
&& (function = XSYMBOL (function)->function, SYMBOLP (function)))
function = indirect_function (function);
if (SUBRP (function))
result = Fsubr_arity (function);
else if (COMPILEDP (function))
result = lambda_arity (function);
else
{
if (NILP (function))
xsignal1 (Qvoid_function, original);
if (!CONSP (function))
xsignal1 (Qinvalid_function, original);
funcar = XCAR (function);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, original);
if (EQ (funcar, Qlambda)
|| EQ (funcar, Qclosure))
result = lambda_arity (function);
else if (EQ (funcar, Qautoload))
{
Fautoload_do_load (function, original, Qnil);
goto retry;
}
else
xsignal1 (Qinvalid_function, original);
}
return result;
}
/* FUN must be either a lambda-expression or a compiled-code object. */
static Lisp_Object
lambda_arity (Lisp_Object fun)
{
Lisp_Object val, syms_left, next;
ptrdiff_t minargs, maxargs;
bool optional;
if (CONSP (fun))
{
if (EQ (XCAR (fun), Qclosure))
{
fun = XCDR (fun); /* Drop `closure'. */
CHECK_LIST_CONS (fun, fun);
}
syms_left = XCDR (fun);
if (CONSP (syms_left))
syms_left = XCAR (syms_left);
else
xsignal1 (Qinvalid_function, fun);
}
else if (COMPILEDP (fun))
{
ptrdiff_t size = ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK;
if (size <= COMPILED_STACK_DEPTH)
xsignal1 (Qinvalid_function, fun);
syms_left = AREF (fun, COMPILED_ARGLIST);
if (INTEGERP (syms_left))
return get_byte_code_arity (syms_left);
}
else
emacs_abort ();
minargs = maxargs = optional = 0;
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
{
next = XCAR (syms_left);
if (!SYMBOLP (next))
xsignal1 (Qinvalid_function, fun);
if (EQ (next, Qand_rest))
return Fcons (make_number (minargs), Qmany);
else if (EQ (next, Qand_optional))
optional = 1;
else
{
if (!optional)
minargs++;
maxargs++;
}
}
if (!NILP (syms_left))
xsignal1 (Qinvalid_function, fun);
return Fcons (make_number (minargs), make_number (maxargs));
}
DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
1, 1, 0,
doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
......@@ -3808,6 +3918,7 @@ alist of active lexical bindings. */);
defsubr (&Seval);
defsubr (&Sapply);
defsubr (&Sfuncall);
defsubr (&Sfunc_arity);
defsubr (&Srun_hooks);
defsubr (&Srun_hook_with_args);
defsubr (&Srun_hook_with_args_until_success);
......
......@@ -4215,6 +4215,7 @@ extern struct byte_stack *byte_stack_list;
extern void relocate_byte_stack (void);
extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, ptrdiff_t, Lisp_Object *);
extern Lisp_Object get_byte_code_arity (Lisp_Object);
/* Defined in macros.c. */
extern void init_macros (void);
......
......@@ -208,3 +208,14 @@
(should (string-version-lessp "foo1.25.5.png" "foo1.125.5"))
(should (string-version-lessp "2" "1245"))
(should (not (string-version-lessp "1245" "2"))))
(ert-deftest fns-tests-func-arity ()
(should (equal (func-arity 'car) '(1 . 1)))
(should (equal (func-arity 'caar) '(1 . 1)))
(should (equal (func-arity 'format) '(1 . many)))
(require 'info)
(should (equal (func-arity 'Info-goto-node) '(1 . 3)))
(should (equal (func-arity (lambda (&rest x))) '(0 . many)))
(should (equal (func-arity (eval (lambda (x &optional y)) nil)) '(1 . 2)))
(should (equal (func-arity (eval (lambda (x &optional y)) t)) '(1 . 2)))
(should (equal (func-arity 'let) '(1 . unevalled))))
Markdown is supported
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