Merge from emacs--devo--0

[bpt/emacs.git] / lisp / emacs-lisp / byte-opt.el

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index db6d96e..6db7aaf 100644 (file)
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1,7 +1,7 @@
 ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
 
 ;; Copyright (C) 1991, 1994, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>
@@ -12,7 +12,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -545,8 +545,8 @@
                                (eq (car-safe (nth 2 last)) 'cdr)
                                (eq (cadr (nth 2 last)) var))))
                    (progn
-                     (byte-compile-warn "value returned by `%s' is not used"
-                                        (prin1-to-string (car form)))
+                     (byte-compile-warn "value returned from %s is unused"
+                                        (prin1-to-string form))
                      nil)))
           (byte-compile-log "  %s called for effect; deleted" fn)
           ;; appending a nil here might not be necessary, but it can't hurt.
@@ -557,8 +557,20 @@
           ;; Otherwise, no args can be considered to be for-effect,
           ;; even if the called function is for-effect, because we
           ;; don't know anything about that function.
-          (cons fn (mapcar 'byte-optimize-form (cdr form)))))))
-
+          (let ((args (mapcar #'byte-optimize-form (cdr form))))
+            (if (and (get fn 'pure)
+                     (byte-optimize-all-constp args))
+                  (list 'quote (apply fn (mapcar #'eval args)))
+              (cons fn args)))))))
+
+(defun byte-optimize-all-constp (list)
+  "Non-nil if all elements of LIST satisfy `byte-compile-constp'."
+  (let ((constant t))
+    (while (and list constant)
+      (unless (byte-compile-constp (car list))
+       (setq constant nil))
+      (setq list (cdr list)))
+    constant))
 
 (defun byte-optimize-form (form &optional for-effect)
   "The source-level pass of the optimizer."
@@ -1117,55 +1129,6 @@
        (byte-optimize-predicate form))
     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)
-(put 'string-to-syntax '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 signaling the error at compile-time."
-  (let ((args (cdr form))
-       (constant t))
-    (while (and args constant)
-      (or (byte-compile-constp (car args))
-         (setq constant nil))
-      (setq args (cdr args)))
-    (if constant
-       (list 'quote (eval form))
-      form)))
-
-;; Avoid having to write forward-... with a negative arg for speed.
-;; Fixme: don't be limited to constant args.
-(put 'backward-char 'byte-optimizer 'byte-optimize-backward-char)
-(defun byte-optimize-backward-char (form)
-  (cond ((and (= 2 (safe-length form))
-             (numberp (nth 1 form)))
-        (list 'forward-char (eval (- (nth 1 form)))))
-       ((= 1 (safe-length form))
-        '(forward-char -1))
-       (t form)))
-
-(put 'backward-word 'byte-optimizer 'byte-optimize-backward-word)
-(defun byte-optimize-backward-word (form)
-  (cond ((and (= 2 (safe-length form))
-             (numberp (nth 1 form)))
-        (list 'forward-word (eval (- (nth 1 form)))))
-       ((= 1 (safe-length form))
-        '(forward-word -1))
-       (t form)))
-
-(put 'char-before 'byte-optimizer 'byte-optimize-char-before)
-(defun byte-optimize-char-before (form)
-  (cond ((= 2 (safe-length form))
-        `(char-after (1- ,(nth 1 form))))
-       ((= 1 (safe-length form))
-        '(char-after (1- (point))))
-       (t form)))
-
 ;; Fixme: delete-char -> delete-region (byte-coded)
 ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
 ;; string-make-multibyte for constant args.
@@ -1295,6 +1258,18 @@ of FORM by signaling the error at compile-time."
     (setq side-effect-and-error-free-fns (cdr side-effect-and-error-free-fns)))
   nil)
 
+\f
+;; pure functions are side-effect free functions whose values depend
+;; only on their arguments. For these functions, calls with constant
+;; arguments can be evaluated at compile time. This may shift run time
+;; errors to compile time.
+
+(let ((pure-fns
+       '(concat symbol-name regexp-opt regexp-quote string-to-syntax)))
+  (while pure-fns
+    (put (car pure-fns) 'pure t)
+    (setq pure-fns (cdr pure-fns)))
+  nil)
 
 (defun byte-compile-splice-in-already-compiled-code (form)
   ;; form is (byte-code "..." [...] n)