Mercurial > hg > xemacs-beta
changeset 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 | 9f738305f80f |
children | 6468cf6f0b9d |
files | lisp/ChangeLog lisp/bytecomp.el lisp/cl-macs.el |
diffstat | 3 files changed, 34 insertions(+), 11 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sat Nov 06 21:18:52 2010 +0000 +++ b/lisp/ChangeLog Sun Nov 14 13:46:29 2010 +0000 @@ -1,3 +1,17 @@ +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. + 2010-10-25 Aidan Kehoe <kehoea@parhasard.net> Add compiler macros and compilation sanity-checking for various
--- 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)
--- a/lisp/cl-macs.el Sat Nov 06 21:18:52 2010 +0000 +++ b/lisp/cl-macs.el Sun Nov 14 13:46:29 2010 +0000 @@ -3270,7 +3270,6 @@ (defun cl-non-fixnum-number-p (object) (and (numberp object) (not (fixnump object)))) -(put 'eql 'byte-compile nil) (define-compiler-macro eql (&whole form a b) (cond ((eq (cl-const-expr-p a) t) (let ((val (cl-const-expr-val a))) @@ -3282,15 +3281,6 @@ (if (cl-non-fixnum-number-p val) (list 'equal a b) (list 'eq a b)))) - ((cl-simple-expr-p a 5) - (list 'if (list 'numberp a) - (list 'equal a b) - (list 'eq a b))) - ((and (cl-safe-expr-p a) - (cl-simple-expr-p b 5)) - (list 'if (list 'numberp b) - (list 'equal a b) - (list 'eq a b))) (t form))) (macrolet