Mercurial > emacs
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.
author | Dave Love <fx@gnu.org> |
---|---|
date | Wed, 23 Feb 2000 12:28:09 +0000 |
parents | 8584ef89a2bd |
children | 6b92fbc04c23 |
comparison
equal
deleted
inserted
replaced
27822:498b7f6777b5 | 27823:08c25ce52bef |
---|---|
1 ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler. | 1 ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler. |
2 | 2 |
3 ;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc. | 3 ;;; Copyright (c) 1991, 1994, 2000 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Jamie Zawinski <jwz@lucid.com> | 5 ;; Author: Jamie Zawinski <jwz@lucid.com> |
6 ;; Hallvard Furuseth <hbf@ulrik.uio.no> | 6 ;; Hallvard Furuseth <hbf@ulrik.uio.no> |
7 ;; Maintainer: FSF | |
7 ;; Keywords: internal | 8 ;; Keywords: internal |
8 | 9 |
9 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
10 | 11 |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
590 ;;; It is now safe to optimize code such that it introduces new bindings. | 591 ;;; It is now safe to optimize code such that it introduces new bindings. |
591 | 592 |
592 ;; I'd like this to be a defsubst, but let's not be self-referential... | 593 ;; I'd like this to be a defsubst, but let's not be self-referential... |
593 (defmacro byte-compile-trueconstp (form) | 594 (defmacro byte-compile-trueconstp (form) |
594 ;; Returns non-nil if FORM is a non-nil constant. | 595 ;; Returns non-nil if FORM is a non-nil constant. |
595 (` (cond ((consp (, form)) (eq (car (, form)) 'quote)) | 596 `(cond ((consp ,form) (eq (car ,form) 'quote)) |
596 ((not (symbolp (, form)))) | 597 ((not (symbolp ,form))) |
597 ((eq (, form) t))))) | 598 ((eq ,form t)) |
599 ((keywordp ,form)))) | |
598 | 600 |
599 ;; If the function is being called with constant numeric args, | 601 ;; If the function is being called with constant numeric args, |
600 ;; evaluate as much as possible at compile-time. This optimizer | 602 ;; evaluate as much as possible at compile-time. This optimizer |
601 ;; assumes that the function is associative, like + or *. | 603 ;; assumes that the function is associative, like + or *. |
602 (defun byte-optimize-associative-math (form) | 604 (defun byte-optimize-associative-math (form) |
893 ;; so arithmetic optimizers recognize the numeric constant. - Hallvard | 895 ;; so arithmetic optimizers recognize the numeric constant. - Hallvard |
894 (put 'quote 'byte-optimizer 'byte-optimize-quote) | 896 (put 'quote 'byte-optimizer 'byte-optimize-quote) |
895 (defun byte-optimize-quote (form) | 897 (defun byte-optimize-quote (form) |
896 (if (or (consp (nth 1 form)) | 898 (if (or (consp (nth 1 form)) |
897 (and (symbolp (nth 1 form)) | 899 (and (symbolp (nth 1 form)) |
898 (not (memq (nth 1 form) '(nil t))))) | 900 (not (byte-compile-const-symbol-p form)))) |
899 form | 901 form |
900 (nth 1 form))) | 902 (nth 1 form))) |
901 | 903 |
902 (defun byte-optimize-zerop (form) | 904 (defun byte-optimize-zerop (form) |
903 (cond ((numberp (nth 1 form)) | 905 (cond ((numberp (nth 1 form)) |
1114 (numberp (nth 1 form))) | 1116 (numberp (nth 1 form))) |
1115 (list 'forward-word (eval (- (nth 1 form))))) | 1117 (list 'forward-word (eval (- (nth 1 form))))) |
1116 ((= 1 (safe-length form)) | 1118 ((= 1 (safe-length form)) |
1117 '(forward-char -1)) | 1119 '(forward-char -1)) |
1118 (t form))) | 1120 (t form))) |
1121 | |
1122 (put 'char-before 'byte-optimizer 'byte-optimize-char-before) | |
1123 (defun byte-optimize-char-before (form) | |
1124 (cond ((= 2 (safe-length form)) | |
1125 `(char-after (1- ,(nth 1 form)))) | |
1126 ((= 1 (safe-length form)) | |
1127 '(char-after (1- (point)))) | |
1128 (t form))) | |
1119 | 1129 |
1120 ;;; enumerating those functions which need not be called if the returned | 1130 ;;; enumerating those functions which need not be called if the returned |
1121 ;;; value is not used. That is, something like | 1131 ;;; value is not used. That is, something like |
1122 ;;; (progn (list (something-with-side-effects) (yow)) | 1132 ;;; (progn (list (something-with-side-effects) (yow)) |
1123 ;;; (foo)) | 1133 ;;; (foo)) |
1130 (let ((side-effect-free-fns | 1140 (let ((side-effect-free-fns |
1131 '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan | 1141 '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan |
1132 assoc assq | 1142 assoc assq |
1133 boundp buffer-file-name buffer-local-variables buffer-modified-p | 1143 boundp buffer-file-name buffer-local-variables buffer-modified-p |
1134 buffer-substring | 1144 buffer-substring |
1135 capitalize car-less-than-car car cdr ceiling concat coordinates-in-window-p | 1145 capitalize car-less-than-car car cdr ceiling concat |
1146 coordinates-in-window-p | |
1136 char-width copy-marker cos count-lines | 1147 char-width copy-marker cos count-lines |
1137 default-boundp default-value documentation downcase | 1148 default-boundp default-value documentation downcase |
1138 elt exp expt fboundp featurep | 1149 elt exp expt fboundp featurep |
1139 file-directory-p file-exists-p file-locked-p file-name-absolute-p | 1150 file-directory-p file-exists-p file-locked-p file-name-absolute-p |
1140 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p | 1151 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p |
1141 float floor format frame-visible-p | 1152 float floor format frame-visible-p |
1142 get gethash get-buffer get-buffer-window getenv get-file-buffer | 1153 get gethash get-buffer get-buffer-window getenv get-file-buffer |
1143 hash-table-count | 1154 hash-table-count |
1144 int-to-string | 1155 int-to-string |
1145 keymap-parent | 1156 keymap-parent |
1146 length local-variable-if-set-p local-variable-p log log10 logand logb logior lognot logxor lsh | 1157 length local-variable-if-set-p local-variable-p log log10 logand |
1158 logb logior lognot logxor lsh | |
1147 marker-buffer max member memq min mod | 1159 marker-buffer max member memq min mod |
1148 next-window nth nthcdr number-to-string | 1160 next-window nth nthcdr number-to-string |
1149 parse-colon-path prefix-numeric-value previous-window | 1161 parse-colon-path prefix-numeric-value previous-window |
1150 radians-to-degrees rassq regexp-quote reverse round | 1162 radians-to-degrees rassq regexp-quote reverse round |
1151 sin sqrt string< string= string-equal string-lessp string-to-char | 1163 sin sqrt string< string= string-equal string-lessp string-to-char |
1482 nil | 1494 nil |
1483 (setq keep-going t) | 1495 (setq keep-going t) |
1484 (if (memq (car lap0) '(byte-constant byte-dup)) | 1496 (if (memq (car lap0) '(byte-constant byte-dup)) |
1485 (progn | 1497 (progn |
1486 (setq tmp (if (or (not tmp) | 1498 (setq tmp (if (or (not tmp) |
1487 (memq (car (cdr lap0)) '(nil t))) | 1499 (byte-compile-const-symbol-p |
1500 (car (cdr lap0)))) | |
1488 (cdr lap0) | 1501 (cdr lap0) |
1489 (byte-compile-get-constant t))) | 1502 (byte-compile-get-constant t))) |
1490 (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s" | 1503 (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s" |
1491 lap0 lap1 lap2 lap0 lap1 | 1504 lap0 lap1 lap2 lap0 lap1 |
1492 (cons (car lap0) tmp)) | 1505 (cons (car lap0) tmp)) |