comparison 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
comparison
equal deleted inserted replaced
5300:9f738305f80f 5301:ec05a30f7148
3158 (byte-defop-compiler cdr-safe 1) 3158 (byte-defop-compiler cdr-safe 1)
3159 (byte-defop-compiler numberp 1) 3159 (byte-defop-compiler numberp 1)
3160 (byte-defop-compiler fixnump 1) 3160 (byte-defop-compiler fixnump 1)
3161 (byte-defop-compiler skip-chars-forward 1-2+1) 3161 (byte-defop-compiler skip-chars-forward 1-2+1)
3162 (byte-defop-compiler skip-chars-backward 1-2+1) 3162 (byte-defop-compiler skip-chars-backward 1-2+1)
3163 (byte-defop-compiler (eql byte-eq) 2) 3163 (byte-defop-compiler eq 2)
3164 (byte-defop-compiler20 old-eq 2) 3164 (byte-defop-compiler20 old-eq 2)
3165 (byte-defop-compiler20 old-memq 2) 3165 (byte-defop-compiler20 old-memq 2)
3166 (byte-defop-compiler cons 2) 3166 (byte-defop-compiler cons 2)
3167 (byte-defop-compiler aref 2) 3167 (byte-defop-compiler aref 2)
3168 (byte-defop-compiler get 2+1) 3168 (byte-defop-compiler get 2+1)
3907 3907
3908 (byte-defop-compiler-1 let) 3908 (byte-defop-compiler-1 let)
3909 (byte-defop-compiler-1 let*) 3909 (byte-defop-compiler-1 let*)
3910 3910
3911 (byte-defop-compiler-1 integerp) 3911 (byte-defop-compiler-1 integerp)
3912 (byte-defop-compiler-1 eql)
3912 (byte-defop-compiler-1 fillarray) 3913 (byte-defop-compiler-1 fillarray)
3913 3914
3914 (defun byte-compile-progn (form) 3915 (defun byte-compile-progn (form)
3915 (byte-compile-body-do-effect (cdr form))) 3916 (byte-compile-body-do-effect (cdr form)))
3916 3917
4140 (byte-compile-out-tag wintag) 4141 (byte-compile-out-tag wintag)
4141 (byte-compile-discard) 4142 (byte-compile-discard)
4142 (byte-compile-discard) 4143 (byte-compile-discard)
4143 (byte-compile-constant t) 4144 (byte-compile-constant t)
4144 (byte-compile-out-tag donetag)))) 4145 (byte-compile-out-tag donetag))))
4146
4147 (defun byte-compile-eql (form)
4148 (if (eql 3 (length form))
4149 (let ((donetag (byte-compile-make-tag))
4150 (eqtag (byte-compile-make-tag)))
4151 (mapc 'byte-compile-form (cdr form))
4152 (byte-compile-out 'byte-dup 0)
4153 (byte-compile-out 'byte-numberp 0)
4154 (byte-compile-goto 'byte-goto-if-nil eqtag)
4155 (byte-compile-out 'byte-dup 0)
4156 (byte-compile-out 'byte-fixnump 0)
4157 (byte-compile-goto 'byte-goto-if-not-nil eqtag)
4158 (byte-compile-out 'byte-equal 0)
4159 (byte-compile-goto 'byte-goto donetag)
4160 (byte-compile-out-tag eqtag)
4161 (byte-compile-out 'byte-eq 0)
4162 (byte-compile-out-tag donetag))
4163 (byte-compile-subr-wrong-args form 2)))
4145 4164
4146 ;;(byte-defop-compiler-1 /= byte-compile-negated) 4165 ;;(byte-defop-compiler-1 /= byte-compile-negated)
4147 (byte-defop-compiler-1 atom byte-compile-negated) 4166 (byte-defop-compiler-1 atom byte-compile-negated)
4148 (byte-defop-compiler-1 nlistp byte-compile-negated) 4167 (byte-defop-compiler-1 nlistp byte-compile-negated)
4149 4168