bug#65797: 29.0.92; func-arity should not return (0 . many) with apply-partially

["Mattias Engdegård" <mattias.engdegard@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 197 bytes --]

Here is one way, but it's mainly aimed at improving performance, not guaranteeing a particular function signature.

(Yet another reason to avoid using buffer-match-p as far as I'm concerned.)


[-- Attachment #2: apply-partially.diff --]
[-- Type: application/octet-stream, Size: 2591 bytes --]

diff --git a/lisp/subr.el b/lisp/subr.el
index 34d87e83310..9c701241b7e 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -519,13 +519,50 @@ frame-configuration-p
   (and (consp object)
        (eq (car object) 'frame-configuration)))
 
+(defun internal--compiler-macro-apply-partially (form &optional fun-arg
+                                                      &rest args)
+  (if (and fun-arg (null args))
+      fun-arg
+    (let ((fun (and (memq (car-safe fun-arg) '(quote function))
+                    (cadr fun-arg))))
+      (if (and (symbolp fun) (functionp fun) (not (autoloadp fun)))
+          (let* ((arity (func-arity fun))
+                 (min-args (car arity))
+                 (max-args (cdr arity))
+                 (nargs (length args)))
+            (cond
+             ((eq max-args 'many) form)
+             ((> nargs max-args)
+              (macroexp-warn-and-return
+               (format-message
+                "`%s' called with %d partial args for `%s' (max is %d)"
+                (car form) nargs fun max-args)
+               form))
+             (t  ; (<= nargs max-args)
+              (let* ((min-extra-args (max (- min-args nargs) 0))
+                     (max-extra-args (- max-args nargs))
+                     (extra-args
+                      (mapcar (lambda (i) (make-symbol (format "x%d" i)))
+                              (number-sequence 1 max-extra-args)))
+                     (fargs (mapcar (lambda (i) (make-symbol (format "a%d" i)))
+                                    (number-sequence 1 nargs))))
+                `(let ,(mapcar (lambda (i) (list (nth i fargs) (nth i args)))
+                               (number-sequence 0 (1- nargs)))
+                   (lambda (,@(take min-extra-args extra-args)
+                            ,@(and (> max-extra-args min-extra-args)
+                                   (cons '&optional
+                                         (nthcdr min-extra-args extra-args))))
+                     (,fun ,@fargs ,@extra-args)))))))
+        form))))
+
 (defun apply-partially (fun &rest args)
   "Return a function that is a partial application of FUN to ARGS.
 ARGS is a list of the first N arguments to pass to FUN.
 The result is a new function which does the same as FUN, except that
 the first N arguments are fixed at the values with which this function
 was called."
-  (declare (side-effect-free error-free))
+  (declare (side-effect-free error-free)
+           (compiler-macro internal--compiler-macro-apply-partially))
   (lambda (&rest args2)
     (apply fun (append args args2))))