[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 6f3243d: Implement 'func-arity'
From: |
Eli Zaretskii |
Subject: |
[Emacs-diffs] master 6f3243d: Implement 'func-arity' |
Date: |
Sat, 26 Mar 2016 08:21:02 +0000 |
branch: master
commit 6f3243db55e61847784178ea812f28ddf003544a
Author: Paul Pogonyshev <address@hidden>
Commit: Eli Zaretskii <address@hidden>
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.
---
doc/lispref/functions.texi | 40 +++++++++++++--
etc/NEWS | 7 +++
src/bytecode.c | 18 +++++++
src/eval.c | 111 ++++++++++++++++++++++++++++++++++++++++++++
src/lisp.h | 1 +
test/src/fns-tests.el | 11 ++++
6 files changed, 182 insertions(+), 6 deletions(-)
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index a2e94c3..ff21abb 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -143,6 +143,37 @@ function, i.e., can be passed to @code{funcall}. Note that
and returns @code{nil} for special forms.
@end defun
+ It is also possible to find out how many arguments an arbitrary
+function expects:
+
address@hidden 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 @address@hidden(@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
address@hidden&rest} arguments, or the symbol @code{unevalled} if
address@hidden is a special form.
+
+Note that this function might return inaccurate results in some
+situations, such as the following:
+
address@hidden @minus
address@hidden
+Functions defined using @code{apply-partially} (@pxref{Calling
+Functions, apply-partially}).
+
address@hidden
+Functions that are advised using @code{advice-add} (@pxref{Advising
+Named Functions}).
+
address@hidden
+Functions that determine the argument list dynamically, as part of
+their code.
address@hidden itemize
+
address@hidden defun
+
@noindent
Unlike @code{functionp}, the next three functions do @emph{not} treat
a symbol as its function definition.
@@ -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
address@hidden(@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
address@hidden 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
diff --git a/etc/NEWS b/etc/NEWS
index 0bc6130..ce21532 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -182,6 +182,13 @@ a new window when opening man pages when there's already
one, use
(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
of a two character construct, i.e. a comment delimiter or escaped
diff --git a/src/bytecode.c b/src/bytecode.c
index 9ae2e82..4ff15d2 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -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)
{
diff --git a/src/eval.c b/src/eval.c
index 74b30e6..64a6655 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -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);
diff --git a/src/lisp.h b/src/lisp.h
index e606ffa..7c8b452 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -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);
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 8617369..688ff1f 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -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))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 6f3243d: Implement 'func-arity',
Eli Zaretskii <=