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: 1955 bytes --]

2013/8/5 Klaus-Dieter Bauer <bauer.klaus.dieter@gmail.com>:
> 2013/8/5 Stefan Monnier <monnier@iro.umontreal.ca>:
>>>     (mapcar (if flag 'f1 'f2) list)
>>>     => (mapcar (if flag #'f1 #'f2) list)
>>
>> No, I definitely don't want to get into such fanciness.
>> But I do want compiler warnings if the coder writes
>>
>>      (mapcar (if flag #'f1 #'f2) list)
>>
>> and `f1' or `f2' are unknown.
>
> My code does that and indeed that was, what I first implemented. I
> then added the second check, where (quote f1) is handled for functions
> known to be higher-order.
>
>>> Shouldn't the markup for user-written functions be a bit easier?
>>
>> I'm not too worried about it, no.  We should instead aim to teach people
>> to write #'foo instead of 'foo.
>
> I am not sure about that... On the one hand, I see your point, since
> consistently writing #'function is better for the byte compiler, as in
> the (if flag #'f1 #'f2) form; If #'f1 is the standard method people
> will write (if flag 'f1 'f2) and not get a warning.
>
> On the other hand though, subjectively, #'f1 is a huge deal more
> visual clutter and somewhat awkward to type (on a German keyboard at
> least). Might be just a training effect, but I also feel that the
> hash-quote sequence moves the attention away from the function name,
> while 'f1 does not (or #f1, '#f1 for that matter, but those are not
> elisp).
>
>   - Klaus

Made a new version of the patch, were warnings are emitted for
registered function arguments. Downside: While educational towards
#'FUNCTION notation, it will result in a good deal of warnings all
across even included code. I'd say this results in a risk of people
ignoring warnings alltogether, including those that likely point out
actual errors such as "reference to free variable". For bytecomp.el
alone it results in 22 warnings!

Advantage would be that using such aggressive "reeducation" the the
declare form would be mostly unnecessary.

  - Klaus

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

--- bytecomp.el.orig	2013-07-02 22:28:34.936731600 +0200
+++ bytecomp.el	2013-08-07 13:16:12.843412700 +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.
@@ -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.
@@ -2960,6 +2964,7 @@
 (defun byte-compile-normal-call (form)
   (when (and (byte-compile-warning-enabled-p 'callargs)
              (symbolp (car form)))
+    (byte-compile--higher-order--check-arguments form)
     (if (memq (car form)
               '(custom-declare-group custom-declare-variable
                                      custom-declare-face))
@@ -4659,6 +4664,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).