(byte-compile-log-lap, byte-compile-inline-expand): Use backquote.

(byte-optimize-pure-func): Rename from byte-optimize-concat.
(symbol-name, regexp-opt, regexp-quote): Mark as pure.

1 files changed, 126 insertions, 119 deletions

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index a07eb64d737..da8e7583438 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1,6 +1,6 @@
 ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
 
-;;; Copyright (c) 1991, 1994, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (c) 1991,1994,2000,01,02,2004  Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;      Hallvard Furuseth <hbf@ulrik.uio.no>
@@ -148,37 +148,37 @@
 
 ;; Other things to consider:
 
-;;;;; Associative math should recognize subcalls to identical function:
-;;;(disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
-;;;;; This should generate the same as (1+ x) and (1- x)
-
-;;;(disassemble (lambda (x) (cons (+ x 1) (- x 1))))
-;;;;; An awful lot of functions always return a non-nil value.  If they're
-;;;;; error free also they may act as true-constants.
-
-;;;(disassemble (lambda (x) (and (point) (foo))))
-;;;;; When
-;;;;;   - all but one arguments to a function are constant
-;;;;;   - the non-constant argument is an if-expression (cond-expression?)
-;;;;; then the outer function can be distributed.  If the guarding
-;;;;; condition is side-effect-free [assignment-free] then the other
-;;;;; arguments may be any expressions.  Since, however, the code size
-;;;;; can increase this way they should be "simple".  Compare:
-
-;;;(disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
-;;;(disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
-
-;;;;; (car (cons A B)) -> (progn B A)
-;;;(disassemble (lambda (x) (car (cons (foo) 42))))
-
-;;;;; (cdr (cons A B)) -> (progn A B)
-;;;(disassemble (lambda (x) (cdr (cons 42 (foo)))))
-
-;;;;; (car (list A B ...)) -> (progn B ... A)
-;;;(disassemble (lambda (x) (car (list (foo) 42 (bar)))))
-
-;;;;; (cdr (list A B ...)) -> (progn A (list B ...))
-;;;(disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
+;; ;; Associative math should recognize subcalls to identical function:
+;; (disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
+;; ;; This should generate the same as (1+ x) and (1- x)
+   
+;; (disassemble (lambda (x) (cons (+ x 1) (- x 1))))
+;; ;; An awful lot of functions always return a non-nil value.  If they're
+;; ;; error free also they may act as true-constants.
+   
+;; (disassemble (lambda (x) (and (point) (foo))))
+;; ;; When
+;; ;;   - all but one arguments to a function are constant
+;; ;;   - the non-constant argument is an if-expression (cond-expression?)
+;; ;; then the outer function can be distributed.  If the guarding
+;; ;; condition is side-effect-free [assignment-free] then the other
+;; ;; arguments may be any expressions.  Since, however, the code size
+;; ;; can increase this way they should be "simple".  Compare:
+   
+;; (disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
+;; (disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
+   
+;; ;; (car (cons A B)) -> (prog1 A B)
+;; (disassemble (lambda (x) (car (cons (foo) 42))))
+   
+;; ;; (cdr (cons A B)) -> (progn A B)
+;; (disassemble (lambda (x) (cdr (cons 42 (foo)))))
+   
+;; ;; (car (list A B ...)) -> (prog1 A B ...)
+;; (disassemble (lambda (x) (car (list (foo) 42 (bar)))))
+   
+;; ;; (cdr (list A B ...)) -> (progn A (list B ...))
+;; (disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
 
 
 ;;; Code:
@@ -217,10 +217,8 @@
                args)))))
 
 (defmacro byte-compile-log-lap (format-string &rest args)
-  (list 'and
-        '(memq byte-optimize-log '(t byte))
-        (cons 'byte-compile-log-lap-1
-              (cons format-string args))))
+  `(and (memq byte-optimize-log '(t byte))
+        (byte-compile-log-lap-1 ,format-string ,@args)))
 
 
 ;;; byte-compile optimizers to support inlining
@@ -274,18 +272,18 @@
             (let (string)
               (fetch-bytecode fn)
               (setq string (aref fn 1))
+              ;; Isn't it an error for `string' not to be unibyte??  --stef
               (if (fboundp 'string-as-unibyte)
                   (setq string (string-as-unibyte string)))
-              (cons (list 'lambda (aref fn 0)
-                          (list 'byte-code string (aref fn 2) (aref fn 3)))
+              (cons `(lambda ,(aref fn 0)
+                       (byte-code ,string ,(aref fn 2) ,(aref fn 3)))
                     (cdr form)))
           (if (eq (car-safe fn) 'lambda)
               (cons fn (cdr form))
             ;; Give up on inlining.
             form))))))
 
-;;; ((lambda ...) ...)
-;;;
+;; ((lambda ...) ...)
 (defun byte-compile-unfold-lambda (form &optional name)
   (or name (setq name "anonymous lambda"))
   (let ((lambda (car form))
@@ -604,14 +602,14 @@
     (nreverse result)))
 
 
-;;; some source-level optimizers
-;;;
-;;; when writing optimizers, be VERY careful that the optimizer returns
-;;; something not EQ to its argument if and ONLY if it has made a change.
-;;; This implies that you cannot simply destructively modify the list;
-;;; you must return something not EQ to it if you make an optimization.
-;;;
-;;; It is now safe to optimize code such that it introduces new bindings.
+;; some source-level optimizers
+;;
+;; when writing optimizers, be VERY careful that the optimizer returns
+;; something not EQ to its argument if and ONLY if it has made a change.
+;; This implies that you cannot simply destructively modify the list;
+;; you must return something not EQ to it if you make an optimization.
+;;
+;; It is now safe to optimize code such that it introduces new bindings.
 
 ;; I'd like this to be a defsubst, but let's not be self-referential...
 (defmacro byte-compile-trueconstp (form)
@@ -721,10 +719,10 @@
          (condition-case ()
              (eval form)
            (error form)))
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker).
-;;      ((null (cdr (cdr form))) (nth 1 form))
+;;;  It is not safe to delete the function entirely
+;;;  (actually, it would be safe if we know the sole arg
+;;;  is not a marker).
+;;;     ((null (cdr (cdr form))) (nth 1 form))
         ((null (cddr form))
          (if (numberp (nth 1 form))
              (nth 1 form)
@@ -763,9 +761,9 @@
                 (numberp last))
            (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form))
                              (delq last (copy-sequence (nthcdr 3 form))))))))
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker).
+;;;  It is not safe to delete the function entirely
+;;;  (actually, it would be safe if we know the sole arg
+;;;  is not a marker).
 ;;;  (if (eq (nth 2 form) 0)
 ;;;      (nth 1 form)                   ; (- x 0)  -->  x
     (byte-optimize-predicate
@@ -780,9 +778,9 @@
   (setq form (byte-optimize-delay-constants-math form 1 '*))
   ;; If there is a constant in FORM, it is now the last element.
   (cond ((null (cdr form)) 1)
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker or if it appears in other arithmetic).
+;;;  It is not safe to delete the function entirely
+;;;  (actually, it would be safe if we know the sole arg
+;;;  is not a marker or if it appears in other arithmetic).
 ;;;     ((null (cdr (cdr form))) (nth 1 form))
         ((let ((last (car (reverse form))))
            (cond ((eq 0 last)  (cons 'progn (cdr form)))
@@ -1117,8 +1115,16 @@
         (byte-optimize-predicate form))
     form))
 
-(put 'concat 'byte-optimizer 'byte-optimize-concat)
-(defun byte-optimize-concat (form)
+(put 'concat 'byte-optimizer 'byte-optimize-pure-func)
+(put 'symbol-name 'byte-optimizer 'byte-optimize-pure-func)
+(put 'regexp-opt 'byte-optimizer 'byte-optimize-pure-func)
+(put 'regexp-quote 'byte-optimizer 'byte-optimize-pure-func)
+(defun byte-optimize-pure-func (form)
+  "Do constant folding for pure functions.
+This assumes that the function will not have any side-effects and that
+its return value depends solely on its arguments.
+If the function can signal an error, this might change the semantics
+of FORM by signalling the error at compile-time."
   (let ((args (cdr form))
         (constant t))
     (while (and args constant)
@@ -1181,28 +1187,28 @@
       `(progn ,(cadr form) (setq ,(cadr var) ,@(cddr form))))
      (t form))))
 
-;;; enumerating those functions which need not be called if the returned
-;;; value is not used.  That is, something like
-;;;    (progn (list (something-with-side-effects) (yow))
-;;;           (foo))
-;;; may safely be turned into
-;;;    (progn (progn (something-with-side-effects) (yow))
-;;;           (foo))
-;;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
-
-;;; Some of these functions have the side effect of allocating memory
-;;; and it would be incorrect to replace two calls with one.
-;;; But we don't try to do those kinds of optimizations,
-;;; so it is safe to list such functions here.
-;;; Some of these functions return values that depend on environment
-;;; state, so that constant folding them would be wrong,
-;;; but we don't do constant folding based on this list.
-
-;;; However, at present the only optimization we normally do
-;;; is delete calls that need not occur, and we only do that
-;;; with the error-free functions.
-
-;;; I wonder if I missed any :-\)
+;; enumerating those functions which need not be called if the returned
+;; value is not used.  That is, something like
+;;    (progn (list (something-with-side-effects) (yow))
+;;           (foo))
+;; may safely be turned into
+;;    (progn (progn (something-with-side-effects) (yow))
+;;           (foo))
+;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
+
+;; Some of these functions have the side effect of allocating memory
+;; and it would be incorrect to replace two calls with one.
+;; But we don't try to do those kinds of optimizations,
+;; so it is safe to list such functions here.
+;; Some of these functions return values that depend on environment
+;; state, so that constant folding them would be wrong,
+;; but we don't do constant folding based on this list.
+
+;; However, at present the only optimization we normally do
+;; is delete calls that need not occur, and we only do that
+;; with the error-free functions.
+
+;; I wonder if I missed any :-\)
 (let ((side-effect-free-fns
        '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
          assoc assq
@@ -1298,8 +1304,8 @@
 (defconst byte-constref-ops
   '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind))
 
-;;; This function extracts the bitfields from variable-length opcodes.
-;;; Originally defined in disass.el (which no longer uses it.)
+;; This function extracts the bitfields from variable-length opcodes.
+;; Originally defined in disass.el (which no longer uses it.)
 
 (defun disassemble-offset ()
   "Don't call this!"
@@ -1336,11 +1342,11 @@
          (aref bytes ptr))))
 
 
-;;; This de-compiler is used for inline expansion of compiled functions,
-;;; and by the disassembler.
-;;;
-;;; This list contains numbers, which are pc values,
-;;; before each instruction.
+;; This de-compiler is used for inline expansion of compiled functions,
+;; and by the disassembler.
+;;
+;; This list contains numbers, which are pc values,
+;; before each instruction.
 (defun byte-decompile-bytecode (bytes constvec)
   "Turns BYTECODE into lapcode, referring to CONSTVEC."
   (let ((byte-compile-constants nil)
@@ -1461,38 +1467,39 @@
      byte-member byte-assq byte-quo byte-rem)
    byte-compile-side-effect-and-error-free-ops))
 
-;;; This crock is because of the way DEFVAR_BOOL variables work.
-;;; Consider the code
-;;;
-;;;     (defun foo (flag)
-;;;       (let ((old-pop-ups pop-up-windows)
-;;;             (pop-up-windows flag))
-;;;         (cond ((not (eq pop-up-windows old-pop-ups))
-;;;                (setq old-pop-ups pop-up-windows)
-;;;                ...))))
-;;;
-;;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
-;;; something else.  But if we optimize
-;;;
-;;;     varref flag
-;;;     varbind pop-up-windows
-;;;     varref pop-up-windows
-;;;     not
-;;; to
-;;;     varref flag
-;;;     dup
-;;;     varbind pop-up-windows
-;;;     not
-;;;
-;;; we break the program, because it will appear that pop-up-windows and
-;;; old-pop-ups are not EQ when really they are.  So we have to know what
-;;; the BOOL variables are, and not perform this optimization on them.
-
-;;; The variable `byte-boolean-vars' is now primitive and updated
-;;; automatically by DEFVAR_BOOL.
+;; This crock is because of the way DEFVAR_BOOL variables work.
+;; Consider the code
+;;
+;;      (defun foo (flag)
+;;        (let ((old-pop-ups pop-up-windows)
+;;              (pop-up-windows flag))
+;;          (cond ((not (eq pop-up-windows old-pop-ups))
+;;                 (setq old-pop-ups pop-up-windows)
+;;                 ...))))
+;;
+;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
+;; something else.  But if we optimize
+;;
+;;      varref flag
+;;      varbind pop-up-windows
+;;      varref pop-up-windows
+;;      not
+;; to
+;;      varref flag
+;;      dup
+;;      varbind pop-up-windows
+;;      not
+;;
+;; we break the program, because it will appear that pop-up-windows and
+;; old-pop-ups are not EQ when really they are.  So we have to know what
+;; the BOOL variables are, and not perform this optimization on them.
+
+;; The variable `byte-boolean-vars' is now primitive and updated
+;; automatically by DEFVAR_BOOL.
 
 (defun byte-optimize-lapcode (lap &optional for-effect)
-  "Simple peephole optimizer.  LAP is both modified and returned."
+  "Simple peephole optimizer.  LAP is both modified and returned.
+If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
   (let (lap0
         lap1
         lap2