comparison lisp/emacs-lisp/byte-opt.el @ 27823:08c25ce52bef

Change old backquote syntax. (byte-compile-trueconstp): Include keywords. (byte-optimize-quote, byte-optimize-lapcode): Use byte-compile-const-symbol-p. (byte-optimize-char-before): New optimization.

27822:498b7f6777b5

;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler.

;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc.

;; Author: Jamie Zawinski <[e-mail]>
;;	Hallvard Furuseth <[e-mail]>
;; Keywords: internal

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

;;; 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)
  ;; Returns non-nil if FORM is a non-nil constant.
  (` (cond ((consp (, form)) (eq (car (, form)) 'quote))
	   ((not (symbolp (, form))))
	   ((eq (, form) t)))))

;; If the function is being called with constant numeric args,
;; evaluate as much as possible at compile-time.  This optimizer 
;; assumes that the function is associative, like + or *.
(defun byte-optimize-associative-math (form)

;; so arithmetic optimizers recognize the numeric constant.  - Hallvard
(put 'quote 'byte-optimizer 'byte-optimize-quote)
(defun byte-optimize-quote (form)
  (if (or (consp (nth 1 form))
	  (and (symbolp (nth 1 form))
	       (not (memq (nth 1 form) '(nil t)))))
      form
    (nth 1 form)))

(defun byte-optimize-zerop (form)
  (cond ((numberp (nth 1 form))

	      (numberp (nth 1 form)))
	 (list 'forward-word (eval (- (nth 1 form)))))
	((= 1 (safe-length form))
	 '(forward-char -1))
	(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))

(let ((side-effect-free-fns
       '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
	 assoc assq
	 boundp buffer-file-name buffer-local-variables buffer-modified-p
	 buffer-substring
	 capitalize car-less-than-car car cdr ceiling concat coordinates-in-window-p
	 char-width copy-marker cos count-lines
	 default-boundp default-value documentation downcase
	 elt exp expt fboundp featurep
	 file-directory-p file-exists-p file-locked-p file-name-absolute-p
	 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
	 float floor format frame-visible-p
	 get gethash get-buffer get-buffer-window getenv get-file-buffer
	 hash-table-count
	 int-to-string
	 keymap-parent
	 length local-variable-if-set-p local-variable-p log log10 logand logb logior lognot logxor lsh
	 marker-buffer max member memq min mod
	 next-window nth nthcdr number-to-string
	 parse-colon-path prefix-numeric-value previous-window
	 radians-to-degrees rassq regexp-quote reverse round
	 sin sqrt string< string= string-equal string-lessp string-to-char

		   nil
		 (setq keep-going t)
		 (if (memq (car lap0) '(byte-constant byte-dup))
		     (progn
		       (setq tmp (if (or (not tmp)
					 (memq (car (cdr lap0)) '(nil t)))
				     (cdr lap0)
				   (byte-compile-get-constant t)))
		       (byte-compile-log-lap "  %s %s %s\t-->\t%s %s %s"
					     lap0 lap1 lap2 lap0 lap1
					     (cons (car lap0) tmp))

27823:08c25ce52bef

;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler.

;;; Copyright (c) 1991, 1994, 2000 Free Software Foundation, Inc.

;; Author: Jamie Zawinski <[e-mail]>
;;	Hallvard Furuseth <[e-mail]>
;; Maintainer: FSF
;; Keywords: internal

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

;;; 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)
  ;; Returns non-nil if FORM is a non-nil constant.
  `(cond ((consp ,form) (eq (car ,form) 'quote))
	 ((not (symbolp ,form)))
	 ((eq ,form t))
	 ((keywordp ,form))))

;; If the function is being called with constant numeric args,
;; evaluate as much as possible at compile-time.  This optimizer 
;; assumes that the function is associative, like + or *.
(defun byte-optimize-associative-math (form)

;; so arithmetic optimizers recognize the numeric constant.  - Hallvard
(put 'quote 'byte-optimizer 'byte-optimize-quote)
(defun byte-optimize-quote (form)
  (if (or (consp (nth 1 form))
	  (and (symbolp (nth 1 form))
	       (not (byte-compile-const-symbol-p form))))
      form
    (nth 1 form)))

(defun byte-optimize-zerop (form)
  (cond ((numberp (nth 1 form))

	      (numberp (nth 1 form)))
	 (list 'forward-word (eval (- (nth 1 form)))))
	((= 1 (safe-length form))
	 '(forward-char -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)))

;;; 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))

(let ((side-effect-free-fns
       '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
	 assoc assq
	 boundp buffer-file-name buffer-local-variables buffer-modified-p
	 buffer-substring
	 capitalize car-less-than-car car cdr ceiling concat
	 coordinates-in-window-p
	 char-width copy-marker cos count-lines
	 default-boundp default-value documentation downcase
	 elt exp expt fboundp featurep
	 file-directory-p file-exists-p file-locked-p file-name-absolute-p
	 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
	 float floor format frame-visible-p
	 get gethash get-buffer get-buffer-window getenv get-file-buffer
	 hash-table-count
	 int-to-string
	 keymap-parent
	 length local-variable-if-set-p local-variable-p log log10 logand
	 logb logior lognot logxor lsh
	 marker-buffer max member memq min mod
	 next-window nth nthcdr number-to-string
	 parse-colon-path prefix-numeric-value previous-window
	 radians-to-degrees rassq regexp-quote reverse round
	 sin sqrt string< string= string-equal string-lessp string-to-char

		   nil
		 (setq keep-going t)
		 (if (memq (car lap0) '(byte-constant byte-dup))
		     (progn
		       (setq tmp (if (or (not tmp)
					 (byte-compile-const-symbol-p
					  (car (cdr lap0))))
				     (cdr lap0)
				   (byte-compile-get-constant t)))
		       (byte-compile-log-lap "  %s %s %s\t-->\t%s %s %s"
					     lap0 lap1 lap2 lap0 lap1
					     (cons (car lap0) tmp))