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