Re: Can the byte-compiler check whether functions passed by name are defined?

[Klaus-Dieter Bauer <bauer.klaus.dieter@gmail.com>]

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

2013/8/8 Stefan Monnier <monnier@iro.umontreal.ca>:
>> (defun foo (&rest args) t)
>> (defun foo2 () (mapcar #'foo '(1 2 3)))
> [...]
>> foo.el:6:1:Warning: the function `foo' is not known to be defined.
>
>> (defun foo () #'assoc-ignore-case)
> [...]
>> foo.el:1:8:Warning: `function' is an obsolete variable.
>
> The patch below should fix them, indeed, thanks.
>
>
>         Stefan
>
>
> === modified file 'lisp/emacs-lisp/bytecomp.el'
> --- lisp/emacs-lisp/bytecomp.el 2013-08-07 17:33:30 +0000
> +++ lisp/emacs-lisp/bytecomp.el 2013-08-08 01:23:52 +0000
> @@ -3574,12 +3574,12 @@
>      (when (and (symbolp f)
>                 (byte-compile-warning-enabled-p 'callargs))
>        (when (get f 'byte-obsolete-info)
> -        (byte-compile-warn-obsolete (car form)))
> +        (byte-compile-warn-obsolete f))
>
>        ;; Check to see if the function will be available at runtime
>        ;; and/or remember its arity if it's unknown.
>        (or (and (or (fboundp f)          ; Might be a subr or autoload.
> -                   (byte-compile-fdefinition (car form) nil))
> +                   (byte-compile-fdefinition f nil))
>                 (not (memq f byte-compile-noruntime-functions)))
>            (eq f byte-compile-current-form) ; ## This doesn't work
>                                             ; with recursion.
>

Applying either of your patches fails for me; Is there some
possibility we can check, that we are actually starting from the same
version of bytecomp.el? I have to admit, I don't have particularily
much experience with patchibg files...

What I intended to check: Does your code allow defining a function
after its first use as #'FUNCTION, as is allowed with normal function
calls (FUNCTION ...)?

>> (funcall (if t #'foo) "Hello World")
>
>(if t #'foo) gets optimized into #'foo.

Okay, I missed that one. If I write

    (funcall (if (some-condition) #'foo) nil)

it warns only about some-condition. I have now moved the call to
`byte-compile--higher-order--check-arguments' to `byte-compile-form'
in my code.

The code

(funcall (if (some-condition) #'foo) nil)
(mapc 'foo nil)
(ignore '(#'bar))

No produces the warnings

-------------------------------------------------------
In toplevel form:
id1379159421d7d15c.el:7:1:Warning: mapc: Function argument should be passed as
    #'foo, not (quote foo)

In end of data:
id1379159421d7d15c.el:11:1:Warning: The symbol `foo' was used as function name
    but the function is not known to be defined.
id1379159421d7d15c.el:11:1:Warning: the function `some-condition' is not known
    to be defined.
Wrote c:/tmp/id1379159421d7d15c.elc
Done.
-------------------------------------------------------


  - Klaus

[-- Attachment #2: bytecomp.el.klaus3.patch --]
[-- Type: application/octet-stream, Size: 13191 bytes --]

--- bytecomp.el.orig	2013-08-08 10:06:58.202295300 +0200
+++ bytecomp.el	2013-08-08 10:40:00.083652500 +0200
@@ -284,6 +284,8 @@
   free-vars   references to variables not in the current lexical scope.
   unresolved  calls to unknown functions.
   callargs    function calls with args that don't match the definition.
+  funcargs    higher order function like mapcar used with function argument 
+              as (quote SYMBOL) rather than (function SYMBOL)
   redefine    function name redefined from a macro to ordinary function or vice
               versa, or redefined to take a different number of arguments.
   obsolete    obsolete variables and functions.
@@ -1364,10 +1366,7 @@
       ;; This is the first definition.  See if previous calls are compatible.
       (let ((calls (assq name byte-compile-unresolved-functions))
 	    nums sig min max)
-        (setq byte-compile-unresolved-functions
-              (delq calls byte-compile-unresolved-functions))
-        (setq calls (delq t calls))  ;Ignore higher-order uses of the function.
-       (when (cdr calls)
+	(when calls
           (when (and (symbolp name)
                      (eq (function-get name 'byte-optimizer)
                          'byte-compile-inline-expand))
@@ -1385,7 +1384,10 @@
              name
              (byte-compile-arglist-signature-string sig)
              (if (equal sig '(1 . 1)) " arg" " args")
-             (byte-compile-arglist-signature-string (cons min max)))))))))
+             (byte-compile-arglist-signature-string (cons min max))))
+
+          (setq byte-compile-unresolved-functions
+                (delq calls byte-compile-unresolved-functions)))))))
 
 (defvar byte-compile-cl-functions nil
   "List of functions defined in CL.")
@@ -1496,6 +1498,7 @@
          (byte-compile-const-variables nil)
          (byte-compile-free-references nil)
          (byte-compile-free-assignments nil)
+	 (byte-compile--higher-order--unresolved-functions nil)
          ;;
          ;; Close over these variables so that `byte-compiler-options'
          ;; can change them on a per-file basis.
@@ -1939,6 +1942,7 @@
 	;; Make warnings about unresolved functions
 	;; give the end of the file as their position.
 	(setq byte-compile-last-position (point-max))
+	(byte-compile--higher-order--warn-about-unresolved-function-names)
 	(byte-compile-warn-about-unresolved-functions))
       ;; Fix up the header at the front of the output
       ;; if the buffer contains multibyte characters.
@@ -2929,6 +2933,8 @@
              (memq fn byte-compile-interactive-only-functions)
              (byte-compile-warn "`%s' used from Lisp code\n\
 That command is designed for interactive use only" fn))
+	(and (byte-compile-warning-enabled-p 'unresolved)
+	     (byte-compile--higher-order--check-arguments form))
         (if (and (fboundp (car form))
                  (eq (car-safe (symbol-function (car form))) 'macro))
             (byte-compile-log-warning
@@ -3574,31 +3580,9 @@
 ;; and (funcall (function foo)) will lose with autoloads.
 
 (defun byte-compile-function-form (form)
-  (let ((f (nth 1 form)))
-    (when (and (symbolp f)
-               (byte-compile-warning-enabled-p 'callargs))
-      (when (get f 'byte-obsolete-info)
-        (byte-compile-warn-obsolete (car form)))
-
-      ;; Check to see if the function will be available at runtime
-      ;; and/or remember its arity if it's unknown.
-      (or (and (or (fboundp f)          ; Might be a subr or autoload.
-                   (byte-compile-fdefinition (car form) nil))
-               (not (memq f byte-compile-noruntime-functions)))
-          (eq f byte-compile-current-form) ; ## This doesn't work
-                                           ; with recursion.
-          ;; It's a currently-undefined function.
-          ;; Remember number of args in call.
-          (let ((cons (assq f byte-compile-unresolved-functions)))
-            (if cons
-                (or (memq t (cdr cons))
-                    (push t (cdr cons)))
-              (push (list f t)
-                    byte-compile-unresolved-functions)))))
-
-    (byte-compile-constant (if (eq 'lambda (car-safe f))
-                               (byte-compile-lambda f)
-                             f))))
+  (byte-compile-constant (if (eq 'lambda (car-safe (nth 1 form)))
+                             (byte-compile-lambda (nth 1 form))
+                           (nth 1 form))))
 
 (defun byte-compile-indent-to (form)
   (let ((len (length form)))
@@ -4681,6 +4665,177 @@
 	      (indent-to 40)
 	      (insert (int-to-string n) "\n")))
 	(setq i (1+ i))))))
+
+;;;; (DECLARE (HIGHER-ORDER-ARGUMENTS)) AND CHECK [BEGINNING] ;;;;;;;;
+
+(defvar byte-compile--higher-order--unresolved-functions nil
+  "A list of functions that were passed by name to higher order functions but where not known to be defined.
+
+Used during compilation to report functions referred to by (quote
+SYMBOL) or (function SYMBOL) that are not known to be defined.
+
+ See also
+`byte-compile--higher-order--warn-about-unresolved-function-names',
+`byte-compile--higher-order--check-arguments'.")
+
+(defun byte-compile--higher-order--warn-about-unresolved-function-names ()
+  "Emit compiler warnings when there are unresolved function a symbols passed to higher order functions.
+See also `byte-compile--higher-order--unresolved-functions'."
+  ;; The logic is similiar to `byte-compile-warn-about-unresolved-functions'.
+  (when (byte-compile-warning-enabled-p 'unresolved)
+    (let ((byte-compile-current-form :end)
+	  not-defined-at-runtime-maybe-symbol-list
+	  resolved-to-function-list
+	  resolved-to-macro-list
+	  unresolved-symbol-list)
+    (dolist (function-name byte-compile--higher-order--unresolved-functions)
+      (cond ((assq function-name byte-compile-function-environment)
+	     (push function-name resolved-to-function-list))
+	    ((assq function-name byte-compile-macro-environment)
+	     (push function-name resolved-to-macro-list))
+	    ((fboundp function-name)
+	     (push function-name not-defined-at-runtime-maybe-symbol-list))
+	    (t (push function-name unresolved-symbol-list))))
+    (dolist (resolved-name resolved-to-function-list)
+      (setq byte-compile--higher-order--unresolved-functions
+	    (delq resolved-name
+		  byte-compile--higher-order--unresolved-functions)))
+    (byte-compile-print-syms 
+     "The symbol `%S' was passed to a function as if the name of a function, but is bound to a macro instead."
+     "The following symbols were passed to a function as if the names functions but are bound to macros instead:"
+     resolved-to-macro-list)
+    (byte-compile-print-syms
+     "The symbol `%S' was used as function name but the function is not known to be defined."
+     "The following symbols were used as function names but the functions are not known to be defined:"
+     unresolved-symbol-list)
+    (byte-compile-print-syms
+     "The function `%S' was used as function name but the function might not be defined at runtime."
+     "The following symbols were used as function names but the functions might not be defined at runtime:"
+     not-defined-at-runtime-maybe-symbol-list))))
+
+(defun byte-compile--higher-order--check-arguments (form)
+  "On FORM, which is a function call, check whether functions passed by name are known to be defined.
+
+If a parameter has the form (function SYMBOL) or it is known to
+be expected to be a function through the `higher-order-arguments'
+property of the symbol (car FORM) and has the form (quote SYMBOL)
+we either warn right away, if SYMBOL is known to be bound to
+something that cannot be passed to higher order functions such as
+special forms and macros. If SYMBOL's function cell is empty, we
+queue the symbol into
+`byte-compile--higher-order--unresolved-functions' for checking
+at the end of the file, see
+`byte-compile--higher-order--warn-about-unresolved-function-names'."
+  (let ((higher-order-arguments
+	 (and (symbolp (car form))
+	      (get (car form) 'higher-order-arguments)))
+	(pos -1))
+    (dolist (subform (cdr form))
+      (setq pos (1+ pos))
+      ;; Check when subform has form (function SYMBOL) or (quote SYMBOL)
+      ;; and position matches one mentioned in higher-order-arguments.
+      (when (or (and (listp subform) ;; case: (function SYMBOL)
+		     (eq (car subform) 'function)
+		     (symbolp (car (cdr subform)))
+		     (null (cdr (cdr subform))))
+		(and (listp subform) ;; case: (quote SYMBOL)
+		     (eq (car subform) 'quote)
+		     (symbolp (car (cdr subform)))
+		     (null (cdr (cdr subform)))
+		     (member pos higher-order-arguments)))
+	(let ((function-name (car (cdr subform))))
+	  ;; Give a style warning when form (quote function) was used.
+	  (when (and (byte-compile-warning-enabled-p 'funcargs)
+		     (eq (car subform) 'quote))
+	    (byte-compile-warn 
+	     "%S: Function argument should be passed as #'%S, not %S"
+	     (car form) (car (cdr subform)) subform))
+	  ;; Is the function already defined or already known to be
+	  ;; defined in this file? Note that macros are not allowed!
+	  (cond ((assq function-name byte-compile-function-environment)) ;; Do nothing.
+		((assq function-name byte-compile-macro-environment)
+		 (byte-compile-warn "Invalid argument `%S' to function `%S': Not a function."
+				    function-name (car form)))
+		((functionp function-name)) ;; No nothing, is ok.
+		((fboundp function-name)
+		 (byte-compile-warn "Invalid argument `%S' to function `%S': Not a function."
+				    function-name (car form)))
+		(t ;; Unknown symbol
+		 (add-to-list 'byte-compile--higher-order--unresolved-functions
+			      function-name))))))))
+
+;; Placing the entry inside the definition of
+;; `defun-declaration-alist' directly for some reason doesn't work.
+(add-to-list 'defun-declarations-alist
+	     '(higher-order-arguments 
+	       byte-compile--higher-order--declare-form-handler))
+
+(defun byte-compile--higher-order--declare-form-handler (f _args &rest val)
+  "Handler for the (declare (higher-order-arguments [NUM ...])) form, see `defun-declarations-alist'.
+
+F is the name of the function, _ARGS the formal parameter list,
+VAL should be (NUM ..).
+
+LIMITATION: When the function has been used before it was
+defined, a compiler warning is emitted pointing out that prior
+use might not have been checked."
+  ;; Check that VAL is list of integers.
+  (if (or (not (listp val))
+	  (delete nil
+	    (mapcar (lambda (e) (not (integerp e)))
+	      val)))
+      ;; Warn about invalid `declare' form
+      (let ((warn-text 
+	     (concat "(declare ..) form (higher-order-arguments [NUM ..]) with invalid arguments "
+		     (mapconcat (lambda (e) (format "%S" e)) val " "))))
+	(if byte-compile-current-file 
+	    (byte-compile-warn "%s" warn-text)
+	  (warn "%s" warn-text))
+	nil)
+    ;; Return a `put' form, but also perform it at compile time.
+    ;; Limitation: Affacts only higher order functions defined before
+    ;; their first use.
+    (when (assq f byte-compile-unresolved-functions)
+      (byte-compile-warn 
+       "%s"
+       (concat "Higher order function " (symbol-name f) " was used before it was defined. "
+	       "Actual parameters were not checked for validity.")))
+    (list 'eval-and-compile 
+	  (list 'put (list 'quote f) ''higher-order-arguments
+		(list 'quote val)))))
+
+;; Setting the property for certain known functions.
+
+(defmacro byte-compile--higher-order--register-known-functions (pos &rest symbol-list)
+  "For elements of SYMBOL-LIST set the higher-order-arguments property to (POS) when it is not yet set.
+
+Only for backward compatibility use in bytecomp.el. If you want
+to set the property for your own functions use
+the (declare (higher-order [NUM ..])) form."
+  (declare (indent 1))
+  (let (forms)
+    (dolist (function-name symbol-list)
+      (push (list 'if (list 'not (list 'get (list 'quote function-name) ''higher-order-arguments))
+		  (list 'put (list 'quote function-name) ''higher-order-arguments 
+			(list 'quote (list pos))))
+	    forms))
+    (cons 'progn (reverse forms))))
+
+(byte-compile--higher-order--register-known-functions 0
+  ;; Functions defined in C-source.
+  apply funcall map-char-table map-charset-chars map-keymap
+  map-keymap-internal mapatoms mapc mapcar mapconcat maphash
+  call-interactively
+  ;; Functions defined in standard elisp files
+  map-keymap-sorted map-query-replace-regexp map-y-or-n-p
+  ;; From the deprecated `cl'
+  map mapcan mapcar* mapcon mapl maplist
+  ;; Non-obsolete non-internal functions from `cl-lib'
+  cl-map cl-mapc cl-mapcan cl-mapcar cl-mapcon cl-maphash cl-mapl
+  cl-maplist)
+
+;;;; (DECLARE (HIGHER-ORDER-ARGUMENTS)) AND CHECK [END] ;;;;;;;;;;;;;;
+
 \f
 ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles
 ;; itself, compile some of its most used recursive functions (at load time).