Mercurial > hg > xemacs-beta
diff lisp/bytecomp.el @ 5301:ec05a30f7148
Fix a bytecomp.el bug compiling #'eql, which was masked by cl-macs.el
lisp/ChangeLog addition:
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 14 Nov 2010 13:46:29 +0000 |
parents | bbff29a01820 |
children | 2a54dfbe434f 002cb5224e4f |
line wrap: on
line diff
--- a/lisp/bytecomp.el Sat Nov 06 21:18:52 2010 +0000 +++ b/lisp/bytecomp.el Sun Nov 14 13:46:29 2010 +0000 @@ -3160,7 +3160,7 @@ (byte-defop-compiler fixnump 1) (byte-defop-compiler skip-chars-forward 1-2+1) (byte-defop-compiler skip-chars-backward 1-2+1) -(byte-defop-compiler (eql byte-eq) 2) +(byte-defop-compiler eq 2) (byte-defop-compiler20 old-eq 2) (byte-defop-compiler20 old-memq 2) (byte-defop-compiler cons 2) @@ -3909,6 +3909,7 @@ (byte-defop-compiler-1 let*) (byte-defop-compiler-1 integerp) +(byte-defop-compiler-1 eql) (byte-defop-compiler-1 fillarray) (defun byte-compile-progn (form) @@ -4143,6 +4144,24 @@ (byte-compile-constant t) (byte-compile-out-tag donetag)))) +(defun byte-compile-eql (form) + (if (eql 3 (length form)) + (let ((donetag (byte-compile-make-tag)) + (eqtag (byte-compile-make-tag))) + (mapc 'byte-compile-form (cdr form)) + (byte-compile-out 'byte-dup 0) + (byte-compile-out 'byte-numberp 0) + (byte-compile-goto 'byte-goto-if-nil eqtag) + (byte-compile-out 'byte-dup 0) + (byte-compile-out 'byte-fixnump 0) + (byte-compile-goto 'byte-goto-if-not-nil eqtag) + (byte-compile-out 'byte-equal 0) + (byte-compile-goto 'byte-goto donetag) + (byte-compile-out-tag eqtag) + (byte-compile-out 'byte-eq 0) + (byte-compile-out-tag donetag)) + (byte-compile-subr-wrong-args form 2))) + ;;(byte-defop-compiler-1 /= byte-compile-negated) (byte-defop-compiler-1 atom byte-compile-negated) (byte-defop-compiler-1 nlistp byte-compile-negated)