branch: externals/compat
commit 5b48dfcc7650eb599c22a29a1c3bc37edd04d34f
Author: Philip Kaludercic <phil...@posteo.net>
Commit: Philip Kaludercic <phil...@posteo.net>
Move compat-func-arity to compat-26.el
---
compat-26.el | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
compat.el | 68 ------------------------------------------------------------
2 files changed, 63 insertions(+), 69 deletions(-)
diff --git a/compat-26.el b/compat-26.el
index 097842b7b5..5759b6310a 100644
--- a/compat-26.el
+++ b/compat-26.el
@@ -40,7 +40,69 @@ FUNC 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."
- (compat-func-arity func))
+ (cond
+ ((or (null func) (and (symbolp func) (not (fboundp func))))
+ (signal 'void-function func))
+ ((and (symbolp func) (not (null func)))
+ (compat-func-arity (symbol-function func)))
+ ((eq (car-safe func) 'macro)
+ (compat-func-arity (cdr func)))
+ ((subrp func)
+ (subr-arity func))
+ ((memq (car-safe func) '(closure lambda))
+ ;; See lambda_arity from eval.c
+ (when (eq (car func) 'closure)
+ (setq func (cdr func)))
+ (let ((syms-left (if (consp func)
+ (car func)
+ (signal 'invalid-function func)))
+ (min-args 0) (max-args 0) optional)
+ (catch 'many
+ (dolist (next syms-left)
+ (cond
+ ((not (symbolp next))
+ (signal 'invalid-function func))
+ ((eq next '&rest)
+ (throw 'many (cons min-args 'many)))
+ ((eq next '&optional)
+ (setq optional t))
+ (t (unless optional
+ (setq min-args (1+ min-args)))
+ (setq max-args (1+ max-args)))))
+ (cons min-args max-args))))
+ ((and (byte-code-function-p func) (numberp (aref func 0)))
+ ;; See get_byte_code_arity from bytecode.c
+ (let ((at (aref func 0)))
+ (cons (logand at 127)
+ (if (= (logand at 128) 0)
+ (ash at -8)
+ 'many))))
+ ((and (byte-code-function-p func) (numberp (aref func 0)))
+ ;; See get_byte_code_arity from bytecode.c
+ (let ((at (aref func 0)))
+ (cons (logand at 127)
+ (if (= (logand at 128) 0)
+ (ash at -8)
+ 'many))))
+ ((and (byte-code-function-p func) (listp (aref func 0)))
+ ;; Based on `byte-compile-make-args-desc', this is required for
+ ;; old versions of Emacs that don't use a integer for the argument
+ ;; list description, per e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.
+ (let ((arglist (aref func 0)) (mandatory 0) nonrest)
+ (while (and arglist (not (memq (car arglist) '(&optional &rest))))
+ (setq mandatory (1+ mandatory))
+ (setq arglist (cdr arglist)))
+ (setq nonrest mandatory)
+ (when (eq (car arglist) '&optional)
+ (setq arglist (cdr arglist))
+ (while (and arglist (not (eq (car arglist) '&rest)))
+ (setq nonrest (1+ nonrest))
+ (setq arglist (cdr arglist))))
+ (cons mandatory (if arglist 'many nonrest))))
+ ((autoloadp func)
+ (autoload-do-load func)
+ (compat-func-arity func))
+ ((signal 'invalid-function func))))
;;;; Defined in fns.c
diff --git a/compat.el b/compat.el
index 8f54c6b591..307bd638cf 100644
--- a/compat.el
+++ b/compat.el
@@ -43,74 +43,6 @@
;;;; Core functionality
-;; The implementation is extracted here so that compatibility advice
-;; can check if the right number of arguments are being handled.
-(defun compat-func-arity (func)
- "A reimplementation of `func-arity' for FUNC."
- (cond
- ((or (null func) (and (symbolp func) (not (fboundp func))))
- (signal 'void-function func))
- ((and (symbolp func) (not (null func)))
- (compat-func-arity (symbol-function func)))
- ((eq (car-safe func) 'macro)
- (compat-func-arity (cdr func)))
- ((subrp func)
- (subr-arity func))
- ((memq (car-safe func) '(closure lambda))
- ;; See lambda_arity from eval.c
- (when (eq (car func) 'closure)
- (setq func (cdr func)))
- (let ((syms-left (if (consp func)
- (car func)
- (signal 'invalid-function func)))
- (min-args 0) (max-args 0) optional)
- (catch 'many
- (dolist (next syms-left)
- (cond
- ((not (symbolp next))
- (signal 'invalid-function func))
- ((eq next '&rest)
- (throw 'many (cons min-args 'many)))
- ((eq next '&optional)
- (setq optional t))
- (t (unless optional
- (setq min-args (1+ min-args)))
- (setq max-args (1+ max-args)))))
- (cons min-args max-args))))
- ((and (byte-code-function-p func) (numberp (aref func 0)))
- ;; See get_byte_code_arity from bytecode.c
- (let ((at (aref func 0)))
- (cons (logand at 127)
- (if (= (logand at 128) 0)
- (ash at -8)
- 'many))))
- ((and (byte-code-function-p func) (numberp (aref func 0)))
- ;; See get_byte_code_arity from bytecode.c
- (let ((at (aref func 0)))
- (cons (logand at 127)
- (if (= (logand at 128) 0)
- (ash at -8)
- 'many))))
- ((and (byte-code-function-p func) (listp (aref func 0)))
- ;; Based on `byte-compile-make-args-desc', this is required for
- ;; old versions of Emacs that don't use a integer for the argument
- ;; list description, per e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.
- (let ((arglist (aref func 0)) (mandatory 0) nonrest)
- (while (and arglist (not (memq (car arglist) '(&optional &rest))))
- (setq mandatory (1+ mandatory))
- (setq arglist (cdr arglist)))
- (setq nonrest mandatory)
- (when (eq (car arglist) '&optional)
- (setq arglist (cdr arglist))
- (while (and arglist (not (eq (car arglist) '&rest)))
- (setq nonrest (1+ nonrest))
- (setq arglist (cdr arglist))))
- (cons mandatory (if arglist 'many nonrest))))
- ((autoloadp func)
- (autoload-do-load func)
- (compat-func-arity func))
- ((signal 'invalid-function func))))
-
(eval-and-compile
(defun compat-maxargs-/= (func n)
"Non-nil when FUNC doesn't accept at most N arguments."
