(byte-compile-maybe-guarded): Restore code commented out 2007-11-10.

[gnu-emacs] / lisp / emacs-lisp / bytecomp.el

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c1f547e215dbd8688451c16a4dbac3b7275a194e..064a7aeb76867db29fdae74291481e007a346dff 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,7 +1,7 @@
 ;;; bytecomp.el --- compilation of Lisp code into byte code
 
 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
 ;;; bytecomp.el --- compilation of Lisp code into byte code
 
 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,

-;;   2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.

 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>


@@ -864,7 +864,7 @@ otherwise pop it")
               (setcar (cdr bytes) (logand pc 255))
               (setcar bytes (lsh pc -8))))
        (setq patchlist (cdr patchlist))))
               (setcar (cdr bytes) (logand pc 255))
               (setcar bytes (lsh pc -8))))
        (setq patchlist (cdr patchlist))))

-    (concat (nreverse bytes))))
+    (apply 'unibyte-string (nreverse bytes))))

 
 \f
 ;;; compile-time evaluation
 
 \f
 ;;; compile-time evaluation


@@ -1053,6 +1053,9 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 (defun byte-compile-warning-series (&rest ignore)
   nil)
 
 (defun byte-compile-warning-series (&rest ignore)
   nil)
 

+;; (compile-mode) will cause this to be loaded.
+(declare-function compilation-forget-errors "compile" ())
+

 ;; Log the start of a file in *Compile-Log*, and mark it as done.
 ;; Return the position of the start of the page in the log buffer.
 ;; But do nothing in batch mode.
 ;; Log the start of a file in *Compile-Log*, and mark it as done.
 ;; Return the position of the start of the page in the log buffer.
 ;; But do nothing in batch mode.


@@ -1258,7 +1261,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
                  (byte-compile-fdefinition (car form) t)))
         (sig (if (and def (not (eq def t)))
                  (byte-compile-arglist-signature
                  (byte-compile-fdefinition (car form) t)))
         (sig (if (and def (not (eq def t)))
                  (byte-compile-arglist-signature

-                  (if (eq 'lambda (car-safe def))
+                  (if (memq (car-safe def) '(declared lambda))

                       (nth 1 def)
                     (if (byte-code-function-p def)
                         (aref def 0)
                       (nth 1 def)
                     (if (byte-code-function-p def)
                         (aref def 0)


@@ -1946,13 +1949,13 @@ and will be removed soon.  See (elisp)Backquote in the manual."))
        (delete-region (point) (progn (re-search-forward "^(")
                                      (beginning-of-line)
                                      (point)))
        (delete-region (point) (progn (re-search-forward "^(")
                                      (beginning-of-line)
                                      (point)))

-       (insert ";;; This file contains multibyte non-ASCII characters\n"
-               ";;; and therefore cannot be loaded into Emacs 19.\n")
-       ;; Replace "19" or "19.29" with "20", twice.
+       (insert ";;; This file contains utf-8 non-ASCII characters\n"
+               ";;; and therefore cannot be loaded into Emacs 21 or earlier.\n")
+       ;; Replace "19" or "19.29" with "22", twice.

        (re-search-forward "19\\(\\.[0-9]+\\)")
        (re-search-forward "19\\(\\.[0-9]+\\)")

-       (replace-match "20")
+       (replace-match "23")

        (re-search-forward "19\\(\\.[0-9]+\\)")
        (re-search-forward "19\\(\\.[0-9]+\\)")

-       (replace-match "20")
+       (replace-match "23")

        ;; Now compensate for the change in size,
        ;; to make sure all positions in the file remain valid.
        (setq delta (- (point-max) old-header-end))
        ;; Now compensate for the change in size,
        ;; to make sure all positions in the file remain valid.
        (setq delta (- (point-max) old-header-end))


@@ -1961,52 +1964,52 @@ and will be removed soon.  See (elisp)Backquote in the manual."))
        (delete-char delta)))))
 
 (defun byte-compile-insert-header (filename inbuffer outbuffer)
        (delete-char delta)))))
 
 (defun byte-compile-insert-header (filename inbuffer outbuffer)

-  (set-buffer inbuffer)
-  (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
-       (dynamic byte-compile-dynamic))
-    (set-buffer outbuffer)
-    (goto-char (point-min))
-    ;; The magic number of .elc files is ";ELC", or 0x3B454C43.  After
-    ;; that is the file-format version number (18, 19 or 20) as a
-    ;; byte, followed by some nulls.  The primary motivation for doing
-    ;; this is to get some binary characters up in the first line of
-    ;; the file so that `diff' will simply say "Binary files differ"
-    ;; instead of actually doing a diff of two .elc files.  An extra
-    ;; benefit is that you can add this to /etc/magic:
-
-    ;; 0       string          ;ELC            GNU Emacs Lisp compiled file,
-    ;; >4      byte            x               version %d
-
-    (insert
-     ";ELC"
-     (if (byte-compile-version-cond byte-compile-compatibility) 18 20)
-     "\000\000\000\n"
-     )
-    (insert ";;; Compiled by "
-           (or (and (boundp 'user-mail-address) user-mail-address)
-               (concat (user-login-name) "@" (system-name)))
-           " on "
-           (current-time-string) "\n;;; from file " filename "\n")
-    (insert ";;; in Emacs version " emacs-version "\n")
-    (insert ";;; "
-           (cond
-            ((eq byte-optimize 'source) "with source-level optimization only")
-            ((eq byte-optimize 'byte) "with byte-level optimization only")
-            (byte-optimize "with all optimizations")
-            (t "without optimization"))
-           (if (byte-compile-version-cond byte-compile-compatibility)
-               "; compiled with Emacs 18 compatibility.\n"
-             ".\n"))
-    (if dynamic
-       (insert ";;; Function definitions are lazy-loaded.\n"))
-    (if (not (byte-compile-version-cond byte-compile-compatibility))
-       (let (intro-string minimum-version)
-         ;; Figure out which Emacs version to require,
-         ;; and what comment to use to explain why.
-         ;; Note that this fails to take account of whether
-         ;; the buffer contains multibyte characters.  We may have to
-         ;; compensate at the end in byte-compile-fix-header.
-         (if dynamic-docstrings
+  (with-current-buffer inbuffer
+    (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
+         (dynamic byte-compile-dynamic))
+      (set-buffer outbuffer)
+      (goto-char (point-min))
+      ;; The magic number of .elc files is ";ELC", or 0x3B454C43.  After
+      ;; that is the file-format version number (18, 19, 20, or 23) as a
+      ;; byte, followed by some nulls.  The primary motivation for doing
+      ;; this is to get some binary characters up in the first line of
+      ;; the file so that `diff' will simply say "Binary files differ"
+      ;; instead of actually doing a diff of two .elc files.  An extra
+      ;; benefit is that you can add this to /etc/magic:
+
+      ;; 0     string          ;ELC            GNU Emacs Lisp compiled file,
+      ;; >4    byte            x               version %d
+
+      (insert
+       ";ELC"
+       (if (byte-compile-version-cond byte-compile-compatibility) 18 23)
+       "\000\000\000\n"
+       )
+      (insert ";;; Compiled by "
+             (or (and (boundp 'user-mail-address) user-mail-address)
+                 (concat (user-login-name) "@" (system-name)))
+             " on "
+             (current-time-string) "\n;;; from file " filename "\n")
+      (insert ";;; in Emacs version " emacs-version "\n")
+      (insert ";;; "
+             (cond
+              ((eq byte-optimize 'source) "with source-level optimization only")
+              ((eq byte-optimize 'byte) "with byte-level optimization only")
+              (byte-optimize "with all optimizations")
+              (t "without optimization"))
+             (if (byte-compile-version-cond byte-compile-compatibility)
+                 "; compiled with Emacs 18 compatibility.\n"
+               ".\n"))
+      (if dynamic
+         (insert ";;; Function definitions are lazy-loaded.\n"))
+      (if (not (byte-compile-version-cond byte-compile-compatibility))
+         (let (intro-string minimum-version)
+           ;; Figure out which Emacs version to require,
+           ;; and what comment to use to explain why.
+           ;; Note that this fails to take account of whether
+           ;; the buffer contains multibyte characters.  We may have to
+           ;; compensate at the end in byte-compile-fix-header.
+           (if dynamic-docstrings

              (setq intro-string
                    ";;; This file uses dynamic docstrings, first added in Emacs 19.29.\n"
                    minimum-version "19.29")
              (setq intro-string
                    ";;; This file uses dynamic docstrings, first added in Emacs 19.29.\n"
                    minimum-version "19.29")


@@ -2035,14 +2038,14 @@ and will be removed soon.  See (elisp)Backquote in the manual."))
           ;; Insert semicolons as ballast, so that byte-compile-fix-header
           ;; can delete them so as to keep the buffer positions
           ;; constant for the actual compiled code.
           ;; Insert semicolons as ballast, so that byte-compile-fix-header
           ;; can delete them so as to keep the buffer positions
           ;; constant for the actual compiled code.

-          ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))
+          ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))

       ;; Here if we want Emacs 18 compatibility.
       (when dynamic-docstrings
        (error "Version-18 compatibility doesn't support dynamic doc strings"))
       (when byte-compile-dynamic
        (error "Version-18 compatibility doesn't support dynamic byte code"))
       (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n"
       ;; Here if we want Emacs 18 compatibility.
       (when dynamic-docstrings
        (error "Version-18 compatibility doesn't support dynamic doc strings"))
       (when byte-compile-dynamic
        (error "Version-18 compatibility doesn't support dynamic byte code"))
       (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n"

-             "\n"))))
+               "\n")))))

 
 (defun byte-compile-output-file-form (form)
   ;; writes the given form to the output buffer, being careful of docstrings
 
 (defun byte-compile-output-file-form (form)
   ;; writes the given form to the output buffer, being careful of docstrings


@@ -2260,6 +2263,13 @@ list that represents a doc string reference.
                   (byte-compile-top-level (nth 2 form) nil 'file))))
     form))
 
                   (byte-compile-top-level (nth 2 form) nil 'file))))
     form))
 

+(put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-define-abbrev-table)
+(defun byte-compile-file-form-define-abbrev-table (form)
+  (when (and (byte-compile-warning-enabled-p 'free-vars)
+             (eq 'quote (car-safe (car-safe (cdr form)))))
+    (push (car-safe (cdr (cadr form))) byte-compile-bound-variables))
+  (byte-compile-keep-pending form))
+

 (put 'custom-declare-variable 'byte-hunk-handler
      'byte-compile-file-form-custom-declare-variable)
 (defun byte-compile-file-form-custom-declare-variable (form)
 (put 'custom-declare-variable 'byte-hunk-handler
      'byte-compile-file-form-custom-declare-variable)
 (defun byte-compile-file-form-custom-declare-variable (form)


@@ -2267,18 +2277,17 @@ list that represents a doc string reference.
     (byte-compile-nogroup-warn form))
   (when (byte-compile-warning-enabled-p 'free-vars)
     (push (nth 1 (nth 1 form)) byte-compile-bound-variables))
     (byte-compile-nogroup-warn form))
   (when (byte-compile-warning-enabled-p 'free-vars)
     (push (nth 1 (nth 1 form)) byte-compile-bound-variables))

+  ;; Don't compile the expression because it may be displayed to the user.
+  ;; (when (eq (car-safe (nth 2 form)) 'quote)
+  ;;   ;; (nth 2 form) is meant to evaluate to an expression, so if we have the
+  ;;   ;; final value already, we can byte-compile it.
+  ;;   (setcar (cdr (nth 2 form))
+  ;;           (byte-compile-top-level (cadr (nth 2 form)) nil 'file)))

   (let ((tail (nthcdr 4 form)))
     (while tail
   (let ((tail (nthcdr 4 form)))
     (while tail

-      ;; If there are any (function (lambda ...)) expressions, compile
-      ;; those functions.
-      (if (and (consp (car tail))
-              (eq (car (car tail)) 'function)
-              (consp (nth 1 (car tail))))
-         (setcar tail (byte-compile-lambda (nth 1 (car tail))))
-       ;; Likewise for a bare lambda.
-       (if (and (consp (car tail))
-                (eq (car (car tail)) 'lambda))
-           (setcar tail (byte-compile-lambda (car tail)))))
+      (unless (keywordp (car tail))      ;No point optimizing keywords.
+        ;; Compile the keyword arguments.
+        (setcar tail (byte-compile-top-level (car tail) nil 'file)))

       (setq tail (cdr tail))))
   form)
 
       (setq tail (cdr tail))))
   form)
 


@@ -2810,6 +2819,20 @@ If FORM is a lambda or a macro, byte-compile it as a function."
         (cdr body))
        (body
         (list body))))
         (cdr body))
        (body
         (list body))))

+
+(put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function)
+(defun byte-compile-declare-function (form)
+  (push (cons (nth 1 form)
+              (if (and (> (length form) 3)
+                       (listp (nth 3 form)))
+                  (list 'declared (nth 3 form))
+                t))                     ; arglist not specified
+        byte-compile-function-environment)
+  ;; We are stating that it _will_ be defined at runtime.
+  (setq byte-compile-noruntime-functions
+        (delq (nth 1 form) byte-compile-noruntime-functions))
+  nil)
+

 \f
 ;; This is the recursive entry point for compiling each subform of an
 ;; expression.
 \f
 ;; This is the recursive entry point for compiling each subform of an
 ;; expression.


@@ -3462,6 +3485,8 @@ That command is designed for interactive use only" fn))
 (byte-defop-compiler-1 mapc byte-compile-funarg)
 (byte-defop-compiler-1 maphash byte-compile-funarg)
 (byte-defop-compiler-1 map-char-table byte-compile-funarg)
 (byte-defop-compiler-1 mapc byte-compile-funarg)
 (byte-defop-compiler-1 maphash byte-compile-funarg)
 (byte-defop-compiler-1 map-char-table byte-compile-funarg)

+(byte-defop-compiler-1 map-char-table byte-compile-funarg-2)
+;; map-charset-chars should be funarg but has optional third arg

 (byte-defop-compiler-1 sort byte-compile-funarg-2)
 (byte-defop-compiler-1 let)
 (byte-defop-compiler-1 let*)
 (byte-defop-compiler-1 sort byte-compile-funarg-2)
 (byte-defop-compiler-1 let)
 (byte-defop-compiler-1 let*)


@@ -3485,6 +3510,32 @@ That command is designed for interactive use only" fn))
       (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
     ,tag))
 
       (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
     ,tag))
 

+;; Return the list of items in CONDITION-PARAM that match PRED-LIST.
+;; Only return items that are not in ONLY-IF-NOT-PRESENT.
+(defun byte-compile-find-bound-condition (condition-param
+                                         pred-list
+                                         &optional only-if-not-present)
+  (let ((result nil)
+       (nth-one nil)
+       (cond-list
+        (if (memq (car-safe condition-param) pred-list)
+            ;; The condition appears by itself.
+            (list condition-param)
+          ;; If the condition is an `and', look for matches among the
+          ;; `and' arguments.
+          (when (eq 'and (car-safe condition-param))
+            (cdr condition-param)))))
+
+    (dolist (crt cond-list)
+      (when (and (memq (car-safe crt) pred-list)
+                (eq 'quote (car-safe (setq nth-one (nth 1 crt))))
+                ;; Ignore if the symbol is already on the unresolved
+                ;; list.
+                (not (assq (nth 1 nth-one) ; the relevant symbol
+                           only-if-not-present)))
+       (push (nth 1 (nth 1 crt)) result)))
+    result))
+

 (defmacro byte-compile-maybe-guarded (condition &rest body)
   "Execute forms in BODY, potentially guarded by CONDITION.
 CONDITION is a variable whose value is a test in an `if' or `cond'.
 (defmacro byte-compile-maybe-guarded (condition &rest body)
   "Execute forms in BODY, potentially guarded by CONDITION.
 CONDITION is a variable whose value is a test in an `if' or `cond'.


@@ -3496,35 +3547,40 @@ being undefined will be suppressed.
 If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
 that suppresses all warnings during execution of BODY."
   (declare (indent 1) (debug t))
 If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
 that suppresses all warnings during execution of BODY."
   (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)))))
+  `(let* ((fbound-list (byte-compile-find-bound-condition
+                       ,condition (list 'fboundp)
+                       byte-compile-unresolved-functions))
+         (bound-list (byte-compile-find-bound-condition
+                      ,condition (list 'boundp 'default-boundp)))

          ;; Maybe add to the bound list.
          (byte-compile-bound-variables
          ;; Maybe add to the bound list.
          (byte-compile-bound-variables

-          (if bound
-              (cons bound byte-compile-bound-variables)
+          (if bound-list
+              (append bound-list byte-compile-bound-variables)

             byte-compile-bound-variables))
          ;; Suppress all warnings, for code not used in Emacs.
             byte-compile-bound-variables))
          ;; Suppress all warnings, for code not used in Emacs.

+         ;; FIXME: by the time this is executed the `featurep'
+         ;; emacs/xemacs tests have been optimized away, so this is
+         ;; not doing anything useful here, is should probably be
+         ;; moved to a different place.
+         ;; It is doing _something_. If this is commented out, then
+         ;; compiling a file which requires another file which
+         ;; defines a defsubst that uses (featurep 'xemacs) results
+         ;; in a spurious compilation warning about the xemacs code. Eg:
+         ;; (defsubst foo () (if (featurep 'xemacs) (setq foo t)))
+         ;; where foo is a free variable.

          (byte-compile-warnings
           (if (member ,condition '((featurep 'xemacs)
          (byte-compile-warnings
           (if (member ,condition '((featurep 'xemacs)

-                                   (not (featurep 'emacs))))
-              nil byte-compile-warnings)))
+                                   (not (featurep 'emacs))))
+              nil byte-compile-warnings))
+         )

      (unwind-protect
         (progn ,@body)
        ;; Maybe remove the function symbol from the unresolved list.
      (unwind-protect
         (progn ,@body)
        ;; Maybe remove the function symbol from the unresolved list.

-       (if fbound
+       (dolist (fbound fbound-list)
+        (when fbound

           (setq byte-compile-unresolved-functions
                 (delq (assq fbound byte-compile-unresolved-functions)
           (setq byte-compile-unresolved-functions
                 (delq (assq fbound byte-compile-unresolved-functions)

-                      byte-compile-unresolved-functions))))))
+                      byte-compile-unresolved-functions)))))))

 
 (defun byte-compile-if (form)
   (byte-compile-form (car (cdr form)))
 
 (defun byte-compile-if (form)
   (byte-compile-form (car (cdr form)))


@@ -4230,7 +4286,7 @@ Must be used only with `-batch', and kills Emacs on completion.
 For example, invoke `emacs -batch -f batch-byte-recompile-directory .'.
 
 Optional argument ARG is passed as second argument ARG to
 For example, invoke `emacs -batch -f batch-byte-recompile-directory .'.
 
 Optional argument ARG is passed as second argument ARG to

-`batch-recompile-directory'; see there for its possible values
+`byte-recompile-directory'; see there for its possible values

 and corresponding effects."
   ;; command-line-args-left is what is left of the command line (startup.el)
   (defvar command-line-args-left)      ;Avoid 'free variable' warning
 and corresponding effects."
   ;; command-line-args-left is what is left of the command line (startup.el)
   (defvar command-line-args-left)      ;Avoid 'free variable' warning