bytecomp changes

[Dave Love]

This patch conflates three changes due to the state of my directories
(sorry):

1. A previous one to check interactive forms which had no response.

2. Checking args of format-like functions (which you might find
   helpful with the Emacs sources).

3. Extends to `cond' clauses the facility for `boundp' and `fboundp'
   forms to guard potentially-undefined references, thus avoiding
   warnings.

I wrote a NEWS entry, but I've lost it.

2004-01-21  Dave Love  <address@hidden>

        * emacs-lisp/bytecomp.el (byte-compile-compatibility): Doc fix.
        (byte-compile-format-warn): New.
        (byte-compile-callargs-warn): Use it.
        (Format, message, error): Add byte-compile-format-like property.
        (byte-compile-maybe-guarded): New.
        (byte-compile-if, byte-compile-cond): Use it.
        (byte-compile-lambda): Compile interactive forms, but discard
        result.

--- bytecomp.el~        12 Jan 2004 23:33:34 -0000
+++ bytecomp.el 21 Jan 2004 19:06:00 -0000
@@ -251,7 +251,9 @@ if you change this variable."
   :type 'boolean)
 
 (defcustom byte-compile-compatibility nil
-  "*Non-nil means generate output that can run in Emacs 18."
+  "*Non-nil means generate output that can run in Emacs 18.
+This only means that it can run in principle, if it doesn't require
+facilities that have been added more recently."
   :group 'bytecomp
   :type 'boolean)
 
@@ -1170,6 +1172,7 @@ Each function's symbol gets marked with 
               "requires"
             "accepts only")
           (byte-compile-arglist-signature-string sig))))
+    (byte-compile-format-warn form)
     ;; Check to see if the function will be available at runtime
     ;; and/or remember its arity if it's unknown.
     (or (and (or sig (fboundp (car form))) ; might be a subr or autoload.
@@ -1187,6 +1190,32 @@ Each function's symbol gets marked with 
                  (cons (list (car form) n)
                        byte-compile-unresolved-functions)))))))
 
+(defun byte-compile-format-warn (form)
+  "Warn if FORM is `format'-like with inconsistent args.
+Applies if head of FORM is a symbol with non-nil property
+`byte-compile-format-like' and first arg is a constant string.
+Then check the number of format fields matches the number of
+extra args."
+  (when (and (symbolp (car form))
+            (stringp (nth 1 form))
+            (get (car form) 'byte-compile-format-like))
+    (let ((nfields (with-temp-buffer
+                    (insert (nth 1 form))
+                    (goto-char 1)
+                    (let ((n 0))
+                      (while (re-search-forward "%." nil t)
+                        (unless (eq ?% (char-after (1+ (match-beginning 0))))
+                          (setq n (1+ n))))
+                      n)))
+         (nargs (- (length form) 2)))
+      (unless (= nargs nfields)
+       (byte-compile-warn
+        "`%s' called with %d args to fill %d format field(s)" (car form)
+        nargs nfields)))))
+
+(dolist (elt '(format message error))
+  (put elt 'byte-compile-format-like t))
+
 ;; Warn if the function or macro is being redefined with a different
 ;; number of arguments.
 (defun byte-compile-arglist-warn (form macrop)
@@ -1254,7 +1283,7 @@ Each function's symbol gets marked with 
   (let ((func (car-safe form)))
     (if (and byte-compile-cl-functions
             (memq func byte-compile-cl-functions)
-            ;; Aliases which won't have been expended at this point.
+            ;; Aliases which won't have been expanded at this point.
             ;; These aren't all aliases of subrs, so not trivial to
             ;; avoid hardwiring the list.
             (not (memq func
@@ -2453,17 +2482,19 @@ If FORM is a lambda or a macro, byte-com
             (if (cdr (cdr int))
                 (byte-compile-warn "malformed interactive spec: %s"
                                    (prin1-to-string int)))
-            ;; If the interactive spec is a call to `list',
-            ;; don't compile it, because `call-interactively'
-            ;; looks at the args of `list'.
+            ;; If the interactive spec is a call to `list', don't
+            ;; compile it, because `call-interactively' looks at the
+            ;; args of `list'.  Actually, compile it to get warnings,
+            ;; but don't use the result.
             (let ((form (nth 1 int)))
               (while (memq (car-safe form) '(let let* progn save-excursion))
                 (while (consp (cdr form))
                   (setq form (cdr form)))
                 (setq form (car form)))
-              (or (eq (car-safe form) 'list)
-                  (setq int (list 'interactive
-                                  (byte-compile-top-level (nth 1 int)))))))
+              (if (eq (car-safe form) 'list)
+                  (byte-compile-top-level (nth 1 int))
+                (setq int (list 'interactive
+                                (byte-compile-top-level (nth 1 int)))))))
            ((cdr int)
             (byte-compile-warn "malformed interactive spec: %s"
                                (prin1-to-string int)))))
@@ -3265,51 +3296,55 @@ If FORM is a lambda or a macro, byte-com
       (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
     ,tag))
 
+(defmacro byte-compile-maybe-guarded (condition &rest body)
+  "Execute forms in BODY, potentially guarded by CONDITION.
+CONDITION is the test in an `if' form or in a `cond' clause.
+BODY is to compile the first arm of the if or the body of the
+cond clause.  If CONDITION is of the form `(foundp 'foo)'
+or `(boundp 'foo)', the relevant warnings from BODY about foo
+being undefined will be suppressed."
+  (declare (indent 1) (debug t))
+  `(let* ((fbound
+          (if (eq 'fboundp (car-safe ,condition))
+              (and (eq 'quote (car-safe (nth 1 ,condition)))
+                   ;; Ignore if the symbol is already on the
+                   ;; unresolved list.
+                   (not (assq (nth 1 (nth 1 ,condition)) ; the relevant symbol
+                              byte-compile-unresolved-functions))
+                   (nth 1 (nth 1 ,condition)))))
+         (bound (if (or (eq 'boundp (car-safe ,condition))
+                        (eq 'default-boundp (car-safe ,condition)))
+                    (and (eq 'quote (car-safe (nth 1 ,condition)))
+                         (nth 1 (nth 1 ,condition)))))
+         ;; Maybe add to the bound list.
+         (byte-compile-bound-variables
+          (if bound
+              (cons bound byte-compile-bound-variables)
+            byte-compile-bound-variables)))
+     (progn ,@body)
+     ;; Maybe remove the function symbol from the unresolved list.
+     (if fbound
+        (setq byte-compile-unresolved-functions
+              (delq (assq fbound byte-compile-unresolved-functions)
+                    byte-compile-unresolved-functions)))))
+
 (defun byte-compile-if (form)
   (byte-compile-form (car (cdr form)))
   ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...'
   ;; and avoid warnings about the relevent symbols in the consequent.
-  (let* ((clause (nth 1 form))
-        (fbound (if (eq 'fboundp (car-safe clause))
-                    (and (eq 'quote (car-safe (nth 1 clause)))
-                         ;; Ignore if the symbol is already on the
-                         ;; unresolved list.
-                         (not (assq
-                               (nth 1 (nth 1 clause)) ; the relevant symbol
-                               byte-compile-unresolved-functions))
-                         (nth 1 (nth 1 clause)))))
-        (bound (if (eq 'boundp (car-safe clause))
-                   (and (eq 'quote (car-safe (nth 1 clause)))
-                        (nth 1 (nth 1 clause)))))
-        (donetag (byte-compile-make-tag)))
+  (let ((clause (nth 1 form))
+       (donetag (byte-compile-make-tag)))
     (if (null (nthcdr 3 form))
        ;; No else-forms
        (progn
          (byte-compile-goto-if nil for-effect donetag)
-         ;; Maybe add to the bound list.
-         (let ((byte-compile-bound-variables
-                (if bound
-                    (cons bound byte-compile-bound-variables)
-                  byte-compile-bound-variables)))
+         (byte-compile-maybe-guarded clause
            (byte-compile-form (nth 2 form) for-effect))
-         ;; Maybe remove the function symbol from the unresolved list.
-         (if fbound
-             (setq byte-compile-unresolved-functions
-                   (delq (assq fbound byte-compile-unresolved-functions)
-                         byte-compile-unresolved-functions)))
          (byte-compile-out-tag donetag))
       (let ((elsetag (byte-compile-make-tag)))
        (byte-compile-goto 'byte-goto-if-nil elsetag)
-       ;; As above for the first form.
-       (let ((byte-compile-bound-variables
-                (if bound
-                    (cons bound byte-compile-bound-variables)
-                  byte-compile-bound-variables)))
-           (byte-compile-form (nth 2 form) for-effect))
-       (if fbound
-           (setq byte-compile-unresolved-functions
-                 (delq (assq fbound byte-compile-unresolved-functions)
-                       byte-compile-unresolved-functions)))
+       (byte-compile-maybe-guarded clause
+         (byte-compile-form (nth 2 form) for-effect))
        (byte-compile-goto 'byte-goto donetag)
        (byte-compile-out-tag elsetag)
        (byte-compile-body (cdr (cdr (cdr form))) for-effect)
@@ -3332,14 +3367,16 @@ If FORM is a lambda or a macro, byte-com
             (if (null (cdr clause))
                 ;; First clause is a singleton.
                 (byte-compile-goto-if t for-effect donetag)
-              (setq nexttag (byte-compile-make-tag))
-              (byte-compile-goto 'byte-goto-if-nil nexttag)
-              (byte-compile-body (cdr clause) for-effect)
-              (byte-compile-goto 'byte-goto donetag)
-              (byte-compile-out-tag nexttag)))))
+                (setq nexttag (byte-compile-make-tag))
+                (byte-compile-goto 'byte-goto-if-nil nexttag)
+                (byte-compile-maybe-guarded (car clause)
+                  (byte-compile-body (cdr clause) for-effect))
+                (byte-compile-goto 'byte-goto donetag)
+                (byte-compile-out-tag nexttag)))))
     ;; Last clause
     (and (cdr clause) (not (eq (car clause) t))
-        (progn (byte-compile-form (car clause))
+        (progn (byte-compile-maybe-guarded (car clause)
+                                           (byte-compile-form (car clause)))
                (byte-compile-goto-if nil for-effect donetag)
                (setq clause (cdr clause))))
     (byte-compile-body-do-effect clause)