Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 5437:002cb5224e4f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with 21.5 trunk.
author Mats Lidell <matsl@xemacs.org>
date Mon, 15 Nov 2010 22:33:52 +0100
parents b9167d522a9a ec05a30f7148
children 8d29f1c4bb98
comparison
equal deleted inserted replaced
5436:da1365dd3f07 5437:002cb5224e4f
3266 ;;; mainly to make sure these macros will be present. 3266 ;;; mainly to make sure these macros will be present.
3267 3267
3268 (defun cl-non-fixnum-number-p (object) 3268 (defun cl-non-fixnum-number-p (object)
3269 (and (numberp object) (not (fixnump object)))) 3269 (and (numberp object) (not (fixnump object))))
3270 3270
3271 (put 'eql 'byte-compile nil)
3272 (define-compiler-macro eql (&whole form a b) 3271 (define-compiler-macro eql (&whole form a b)
3273 (cond ((eq (cl-const-expr-p a) t) 3272 (cond ((eq (cl-const-expr-p a) t)
3274 (let ((val (cl-const-expr-val a))) 3273 (let ((val (cl-const-expr-val a)))
3275 (if (cl-non-fixnum-number-p val) 3274 (if (cl-non-fixnum-number-p val)
3276 (list 'equal a b) 3275 (list 'equal a b)
3278 ((eq (cl-const-expr-p b) t) 3277 ((eq (cl-const-expr-p b) t)
3279 (let ((val (cl-const-expr-val b))) 3278 (let ((val (cl-const-expr-val b)))
3280 (if (cl-non-fixnum-number-p val) 3279 (if (cl-non-fixnum-number-p val)
3281 (list 'equal a b) 3280 (list 'equal a b)
3282 (list 'eq a b)))) 3281 (list 'eq a b))))
3283 ((cl-simple-expr-p a 5)
3284 (list 'if (list 'numberp a)
3285 (list 'equal a b)
3286 (list 'eq a b)))
3287 ((and (cl-safe-expr-p a)
3288 (cl-simple-expr-p b 5))
3289 (list 'if (list 'numberp b)
3290 (list 'equal a b)
3291 (list 'eq a b)))
3292 (t form))) 3282 (t form)))
3293 3283
3294 (macrolet 3284 (macrolet
3295 ((define-star-compiler-macros (&rest macros) 3285 ((define-star-compiler-macros (&rest macros)
3296 "For `member*', `assoc*' and `rassoc*' with constant ITEM or 3286 "For `member*', `assoc*' and `rassoc*' with constant ITEM or