changeset: 5301:ec05a30f7148 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net&gt; 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&gt; * 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&gt; + + * 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&gt; 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