[elpa] externals/compat 5b48dfcc76 1/4: Move compat-func-arity to compat-26.el

[ELPA Syncer]

branch: externals/compat
commit 5b48dfcc7650eb599c22a29a1c3bc37edd04d34f
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@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."