comparison lisp/emacs-lisp/byte-opt.el @ 91015:b83d0dadb2a7

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 857-865) - Update from CVS - Merge from emacs--rel--22 - Update from CVS: lisp/emacs-lisp/avl-tree.el: New file. - Remove RCS keywords * emacs--rel--22 (patch 97-100) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 246-247) - Update from CVS Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-252
author Miles Bader <miles@gnu.org>
date Wed, 29 Aug 2007 05:03:40 +0000
parents 424b655804ca 92ccd83174e6
children d38543a1c0f9
comparison
equal deleted inserted replaced
91014:2392e6a45952 91015:b83d0dadb2a7
29 29
30 ;; ======================================================================== 30 ;; ========================================================================
31 ;; "No matter how hard you try, you can't make a racehorse out of a pig. 31 ;; "No matter how hard you try, you can't make a racehorse out of a pig.
32 ;; You can, however, make a faster pig." 32 ;; You can, however, make a faster pig."
33 ;; 33 ;;
34 ;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code 34 ;; Or, to put it another way, the Emacs byte compiler is a VW Bug. This code
35 ;; makes it be a VW Bug with fuel injection and a turbocharger... You're 35 ;; makes it be a VW Bug with fuel injection and a turbocharger... You're
36 ;; still not going to make it go faster than 70 mph, but it might be easier 36 ;; still not going to make it go faster than 70 mph, but it might be easier
37 ;; to get it there. 37 ;; to get it there.
38 ;; 38 ;;
39 39
1012 (cons (car form) (cdr (cdr form))))) 1012 (cons (car form) (cdr (cdr form)))))
1013 form)) 1013 form))
1014 form)) 1014 form))
1015 1015
1016 (defun byte-optimize-if (form) 1016 (defun byte-optimize-if (form)
1017 ;; (if (progn <insts> <test>) <rest>) ==> (progn <insts> (if <test> <rest>))
1017 ;; (if <true-constant> <then> <else...>) ==> <then> 1018 ;; (if <true-constant> <then> <else...>) ==> <then>
1018 ;; (if <false-constant> <then> <else...>) ==> (progn <else...>) 1019 ;; (if <false-constant> <then> <else...>) ==> (progn <else...>)
1019 ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>)) 1020 ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>))
1020 ;; (if <test> <then> nil) ==> (if <test> <then>) 1021 ;; (if <test> <then> nil) ==> (if <test> <then>)
1021 (let ((clause (nth 1 form))) 1022 (let ((clause (nth 1 form)))
1022 (cond ((byte-compile-trueconstp clause) 1023 (cond ((and (eq (car-safe clause) 'progn)
1024 ;; `clause' is a proper list.
1025 (null (cdr (last clause))))
1026 (if (null (cddr clause))
1027 ;; A trivial `progn'.
1028 (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form)))
1029 (nconc (butlast clause)
1030 (list
1031 (byte-optimize-if
1032 `(if ,(car (last clause)) ,@(nthcdr 2 form)))))))
1033 ((byte-compile-trueconstp clause)
1023 (nth 2 form)) 1034 (nth 2 form))
1024 ((null clause) 1035 ((null clause)
1025 (if (nthcdr 4 form) 1036 (if (nthcdr 4 form)
1026 (cons 'progn (nthcdr 3 form)) 1037 (cons 'progn (nthcdr 3 form))
1027 (nth 3 form))) 1038 (nth 3 form)))
1133 ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte, 1144 ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
1134 ;; string-make-multibyte for constant args. 1145 ;; string-make-multibyte for constant args.
1135 1146
1136 (put 'featurep 'byte-optimizer 'byte-optimize-featurep) 1147 (put 'featurep 'byte-optimizer 'byte-optimize-featurep)
1137 (defun byte-optimize-featurep (form) 1148 (defun byte-optimize-featurep (form)
1138 ;; Emacs-21's byte-code doesn't run under XEmacs anyway, so we can 1149 ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we
1139 ;; safely optimize away this test. 1150 ;; can safely optimize away this test.
1140 (if (equal '((quote xemacs)) (cdr-safe form)) 1151 (if (member (cdr-safe form) '((quote xemacs) (quote sxemacs)))
1141 nil 1152 nil
1142 form)) 1153 form))
1143 1154
1144 (put 'set 'byte-optimizer 'byte-optimize-set) 1155 (put 'set 'byte-optimizer 'byte-optimize-set)
1145 (defun byte-optimize-set (form) 1156 (defun byte-optimize-set (form)
1329 ;; and by the disassembler. 1340 ;; and by the disassembler.
1330 ;; 1341 ;;
1331 ;; This list contains numbers, which are pc values, 1342 ;; This list contains numbers, which are pc values,
1332 ;; before each instruction. 1343 ;; before each instruction.
1333 (defun byte-decompile-bytecode (bytes constvec) 1344 (defun byte-decompile-bytecode (bytes constvec)
1334 "Turns BYTECODE into lapcode, referring to CONSTVEC." 1345 "Turn BYTECODE into lapcode, referring to CONSTVEC."
1335 (let ((byte-compile-constants nil) 1346 (let ((byte-compile-constants nil)
1336 (byte-compile-variables nil) 1347 (byte-compile-variables nil)
1337 (byte-compile-tag-number 0)) 1348 (byte-compile-tag-number 0))
1338 (byte-decompile-bytecode-1 bytes constvec))) 1349 (byte-decompile-bytecode-1 bytes constvec)))
1339 1350