bytecomp warning for CL functions

[Dave Love]

This helps to debug the use of the CL package at runtime.  It's not
clean but I couldn't see a better way of doing it quickly and simply
and it serves my purposes.  Perhaps someone else can.

2002-06-19  Dave Love  <fx@gnu.org>

        * emacs-lisp/bytecomp.el (byte-compile-warning-types): Doc fix.
        (byte-compile-warnings): Doc fix.  Add cl-func option.
        (byte-compile-cl-warn): New function.
        (byte-compile-form): Use it.

*** bytecomp.el.~2.85.~ Tue Aug 21 18:01:57 2001
--- bytecomp.el Wed Jun 19 15:34:15 2002
***************
*** 1,6 ****
  ;;; bytecomp.el --- compilation of Lisp code into byte code
  
! ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001
  ;;   Free Software Foundation, Inc.
  
  ;; Author: Jamie Zawinski <jwz@lucid.com>
--- 1,6 ----
  ;;; bytecomp.el --- compilation of Lisp code into byte code
  
! ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002
  ;;   Free Software Foundation, Inc.
  
  ;; Author: Jamie Zawinski <jwz@lucid.com>
***************
*** 326,335 ****
    :group 'bytecomp
    :type 'boolean)
  
  (defconst byte-compile-warning-types
!   '(redefine callargs free-vars unresolved obsolete noruntime))
  (defcustom byte-compile-warnings t
    "*List of warnings that the byte-compiler should issue (t for all).
  Elements of the list may be be:
  
    free-vars   references to variables not in the current lexical scope.
--- 326,340 ----
    :group 'bytecomp
    :type 'boolean)
  
+ ;; `cl-func' isn't here because it probably should only be defined
+ ;; explicitly.
  (defconst byte-compile-warning-types
!   '(redefine callargs free-vars unresolved obsolete noruntime)
!   "The list of warning types used when `byte-compile-warnings' is t.")
  (defcustom byte-compile-warnings t
    "*List of warnings that the byte-compiler should issue (t for all).
+ Actually, t selects all but `cl-func'.
+ 
  Elements of the list may be be:
  
    free-vars   references to variables not in the current lexical scope.
***************
*** 337,349 ****
    callargs    lambda calls with args that don't match the definition.
    redefine    function cell redefined from a macro to a lambda or vice
                versa, or redefined to take a different number of arguments.
!   obsolete    obsolete variables and functions."
    :group 'bytecomp
!   :type '(choice (const :tag "All" t)
                 (set :menu-tag "Some"
                      (const free-vars) (const unresolved)
!                     (const callargs) (const redefined)
!                     (const obsolete) (const noruntime))))
  
  (defcustom byte-compile-generate-call-tree nil
    "*Non-nil means collect call-graph information when compiling.
--- 342,358 ----
    callargs    lambda calls with args that don't match the definition.
    redefine    function cell redefined from a macro to a lambda or vice
                versa, or redefined to take a different number of arguments.
!   obsolete    obsolete variables and functions.
!   noruntime   functions that may not be defined at runtime (typically
!               defined only under `eval-when-compile').
!   cl-func     calls to runtime functions from the CL package (as opposed to
!               macros and aliases)."
    :group 'bytecomp
!   :type `(choice (const :tag "All" t)
                 (set :menu-tag "Some"
                      (const free-vars) (const unresolved)
!                     (const callargs) (const redefine)
!                     (const obsolete) (const noruntime) (const cl-func))))
  
  (defcustom byte-compile-generate-call-tree nil
    "*Non-nil means collect call-graph information when compiling.
***************
*** 1126,1131 ****
--- 1135,1161 ----
                    (delq calls byte-compile-unresolved-functions)))))
        )))
  
+ (defun byte-compile-cl-warn (form)
+   "Warn if FORM is a call of a function from the CL package."
+   (let* ((func (car-safe form))
+        (library
+         (if func
+             (cond ((eq (car-safe func) 'autoload)
+                    (nth 1 func))
+                   ((symbol-file func))))))
+     (if (and library
+            (string-match "^cl\\>" library)
+            ;; Aliases which won't have been expended at this point.
+            ;; These aren't all aliases of subrs, so not trivial to
+            ;; avoid hardwiring the list.
+            (not (memq func
+                       '(cl-block-wrapper cl-block-throw values values-list
+                         multiple-value-list multiple-value-call nth-value
+                         copy-seq first second rest endp cl-member))))
+       (byte-compile-warn "Function from cl package called at runtime: %s"
+                          func)))
+   form)
+ 
  (defun byte-compile-print-syms (str1 strn syms)
    (cond
     ((cdr syms)
***************
*** 2377,2383 ****
               (funcall handler form)
             (if (memq 'callargs byte-compile-warnings)
                 (byte-compile-callargs-warn form))
!            (byte-compile-normal-call form))))
        ((and (or (byte-code-function-p (car form))
                  (eq (car-safe (car form)) 'lambda))
              ;; if the form comes out the same way it went in, that's
--- 2407,2415 ----
               (funcall handler form)
             (if (memq 'callargs byte-compile-warnings)
                 (byte-compile-callargs-warn form))
!            (byte-compile-normal-call form))
!          (if (memq 'cl-func byte-compile-warnings)
!              (byte-compile-cl-warn form))))
        ((and (or (byte-code-function-p (car form))
                  (eq (car-safe (car form)) 'lambda))
              ;; if the form comes out the same way it went in, that's