carbon2-commit: Fix a bytecomp.el bug compiling #'eql, which was masked by cl-macs.el
changeset: 5359:ec05a30f7148
parent: 5356:9f738305f80f
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Nov 14 13:46:29 2010 +0000
files: lisp/ChangeLog lisp/bytecomp.el lisp/cl-macs.el
description:
Fix a bytecomp.el bug compiling #'eql, which was masked by cl-macs.el
lisp/ChangeLog addition:
2010-11-14 Aidan Kehoe <kehoea(a)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.
diff -r 9f738305f80f -r ec05a30f7148 lisp/ChangeLog
--- 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(a)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(a)parhasard.net>
Add compiler macros and compilation sanity-checking for various
diff -r 9f738305f80f -r ec05a30f7148 lisp/bytecomp.el
--- 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)
＠＠ -4142,6 +4143,24 ＠＠
(byte-compile-discard)
(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)
diff -r 9f738305f80f -r ec05a30f7148 lisp/cl-macs.el
--- 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
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches