comparison lisp/emacs-lisp/byte-opt.el @ 90813:e6fdae9180d4

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 698-710) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 216) - Update from CVS Revision: [e-mail]/emacs--unicode--0--patch-196

90812:6137cc8ddf90

	  (t
	   ;; 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)))))))


(defun byte-optimize-form (form &optional for-effect)
  "The source-level pass of the optimizer."
  ;;
  ;; First, optimize all sub-forms of this one.

	    (while (>= (setq count (1- count)) 0)
	      (setq form (list 'cdr form)))
	    form)
	(byte-optimize-predicate 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)))

;; Fixme: delete-char -> delete-region (byte-coded)
;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
;; string-make-multibyte for constant args.

  (while side-effect-and-error-free-fns
    (put (car side-effect-and-error-free-fns) 'side-effect-free 'error-free)
    (setq side-effect-and-error-free-fns (cdr side-effect-and-error-free-fns)))
  nil)


(defun byte-compile-splice-in-already-compiled-code (form)
  ;; form is (byte-code "..." [...] n)
  (if (not (memq byte-optimize '(t lap)))
      (byte-compile-normal-call form)

90813:e6fdae9180d4

	  (t
	   ;; 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.
	   (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 iff 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."
  ;;
  ;; First, optimize all sub-forms of this one.

	    (while (>= (setq count (1- count)) 0)
	      (setq form (list 'cdr form)))
	    form)
	(byte-optimize-predicate form))
    form))

;; Fixme: delete-char -> delete-region (byte-coded)
;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
;; string-make-multibyte for constant args.

  (while side-effect-and-error-free-fns
    (put (car side-effect-and-error-free-fns) 'side-effect-free 'error-free)
    (setq side-effect-and-error-free-fns (cdr side-effect-and-error-free-fns)))
  nil)


;; 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)
  (if (not (memq byte-optimize '(t lap)))
      (byte-compile-normal-call form)