From: Stefan Monnier Date: Mon, 22 Mar 2004 15:21:08 +0000 (+0000) Subject: (byte-compile-log-lap, byte-compile-inline-expand): Use backquote. X-Git-Tag: ttn-vms-21-2-B4~7156 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e856a453a1c1ce1907b3b582841bce3e9cff8cec;p=emacs.git (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. --- 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 ;; Hallvard Furuseth @@ -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