Mercurial > hg > xemacs-beta
comparison lisp/cl-macs.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 | 09fed7053634 002cb5224e4f |
comparison
equal
deleted
inserted
replaced
| 5300:9f738305f80f | 5301:ec05a30f7148 |
|---|---|
| 3268 ;;; mainly to make sure these macros will be present. | 3268 ;;; mainly to make sure these macros will be present. |
| 3269 | 3269 |
| 3270 (defun cl-non-fixnum-number-p (object) | 3270 (defun cl-non-fixnum-number-p (object) |
| 3271 (and (numberp object) (not (fixnump object)))) | 3271 (and (numberp object) (not (fixnump object)))) |
| 3272 | 3272 |
| 3273 (put 'eql 'byte-compile nil) | |
| 3274 (define-compiler-macro eql (&whole form a b) | 3273 (define-compiler-macro eql (&whole form a b) |
| 3275 (cond ((eq (cl-const-expr-p a) t) | 3274 (cond ((eq (cl-const-expr-p a) t) |
| 3276 (let ((val (cl-const-expr-val a))) | 3275 (let ((val (cl-const-expr-val a))) |
| 3277 (if (cl-non-fixnum-number-p val) | 3276 (if (cl-non-fixnum-number-p val) |
| 3278 (list 'equal a b) | 3277 (list 'equal a b) |
| 3280 ((eq (cl-const-expr-p b) t) | 3279 ((eq (cl-const-expr-p b) t) |
| 3281 (let ((val (cl-const-expr-val b))) | 3280 (let ((val (cl-const-expr-val b))) |
| 3282 (if (cl-non-fixnum-number-p val) | 3281 (if (cl-non-fixnum-number-p val) |
| 3283 (list 'equal a b) | 3282 (list 'equal a b) |
| 3284 (list 'eq a b)))) | 3283 (list 'eq a b)))) |
| 3285 ((cl-simple-expr-p a 5) | |
| 3286 (list 'if (list 'numberp a) | |
| 3287 (list 'equal a b) | |
| 3288 (list 'eq a b))) | |
| 3289 ((and (cl-safe-expr-p a) | |
| 3290 (cl-simple-expr-p b 5)) | |
| 3291 (list 'if (list 'numberp b) | |
| 3292 (list 'equal a b) | |
| 3293 (list 'eq a b))) | |
| 3294 (t form))) | 3284 (t form))) |
| 3295 | 3285 |
| 3296 (macrolet | 3286 (macrolet |
| 3297 ((define-star-compiler-macros (&rest macros) | 3287 ((define-star-compiler-macros (&rest macros) |
| 3298 "For `member*', `assoc*' and `rassoc*' with constant ITEM or | 3288 "For `member*', `assoc*' and `rassoc*' with constant ITEM or |