APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1336409784 -3600 # Node ID e63bb7b22c8f6078e97bba15561799d127e75c77 # Parent 289cf21be887b161e4e22c42088a1184d81058c0 Add compiler macros for #'equal, #'member, ... where #'eq, #'memq appropriate. lisp/ChangeLog addition: 2012-05-07 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cl-macs.el: * cl-macs.el (cl-non-fixnum-number-p): Rename, to cl-non-immediate-number-p. This is a little more informative as a name, though still not ideal, in that it will give t for some immediate fixnums on 64-bit builds. * cl-macs.el (eql): * cl-macs.el (define-star-compiler-macros): * cl-macs.el (delq): * cl-macs.el (remq): Use the new name. * cl-macs.el (cl-equal-equivalent-to-eq-p): New. * cl-macs.el (cl-car-or-pi): New. * cl-macs.el (cl-cdr-or-pi): New. * cl-macs.el (equal): New compiler macro. * cl-macs.el (member): New compiler macro. * cl-macs.el (assoc): New compiler macro. * cl-macs.el (rassoc): New compiler macro. If any of #'equal, #'member, #'assoc or #'rassoc has a constant argument such that #'eq, #'memq, #'assq or #'rassq, respectively, are equivalent, make the substitution. Relevant in files like ispell.el, there's a reasonable amount of code out there that doesn't quite get the distinction. diff -r 289cf21be887 -r e63bb7b22c8f lisp/ChangeLog --- a/lisp/ChangeLog Sun May 06 15:29:59 2012 +0100 +++ b/lisp/ChangeLog Mon May 07 17:56:24 2012 +0100 ＠＠ -229,6 +229,31 ＠＠ (since the compiler macro adds :test #'eq to the delete* call if it's not clear that FOO is not a non-fixnum number). +2012-05-07 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * cl-macs.el: + * cl-macs.el (cl-non-fixnum-number-p): Rename, to + cl-non-immediate-number-p. This is a little more informative as a + name, though still not ideal, in that it will give t for some + immediate fixnums on 64-bit builds. + * cl-macs.el (eql): + * cl-macs.el (define-star-compiler-macros): + * cl-macs.el (delq): + * cl-macs.el (remq): + Use the new name. + * cl-macs.el (cl-equal-equivalent-to-eq-p): New. + * cl-macs.el (cl-car-or-pi): New. + * cl-macs.el (cl-cdr-or-pi): New. + * cl-macs.el (equal): New compiler macro. + * cl-macs.el (member): New compiler macro. + * cl-macs.el (assoc): New compiler macro. + * cl-macs.el (rassoc): New compiler macro. + If any of #'equal, #'member, #'assoc or #'rassoc has a constant + argument such that #'eq, #'memq, #'assq or #'rassq, respectively, + are equivalent, make the substitution. Relevant in files like + ispell.el, there's a reasonable amount of code out there that + doesn't quite get the distinction. + 2012-05-01 Aidan Kehoe <kehoea(a)parhasard.net&gt; * byte-optimize.el (byte-optimize-form-code-walker): diff -r 289cf21be887 -r e63bb7b22c8f lisp/cl-macs.el --- a/lisp/cl-macs.el Sun May 06 15:29:59 2012 +0100 +++ b/lisp/cl-macs.el Mon May 07 17:56:24 2012 +0100 ＠＠ -3203,7 +3203,7 ＠＠ ((most-positive-fixnum-on-32-bit-machines () (1- (lsh 1 30))) (most-negative-fixnum-on-32-bit-machines () (lognot (most-positive-fixnum-on-32-bit-machines)))) - (defun cl-non-fixnum-number-p (object) + (defun cl-non-immediate-number-p (object) "Return t if OBJECT is a number not guaranteed to be immediate." (and (numberp object) (or (not (fixnump object)) ＠＠ -3218,16 +3218,55 ＠＠ (define-compiler-macro eql (&whole form a b) (cond ((eq (cl-const-expr-p a) t) (let ((val (cl-const-expr-val a))) - (if (cl-non-fixnum-number-p val) + (if (cl-non-immediate-number-p val) (list 'equal a b) (list 'eq a b)))) ((eq (cl-const-expr-p b) t) (let ((val (cl-const-expr-val b))) - (if (cl-non-fixnum-number-p val) + (if (cl-non-immediate-number-p val) (list 'equal a b) (list 'eq a b)))) (t form))) +(defun cl-equal-equivalent-to-eq-p (object) + (or (symbolp object) (characterp object) + (and (fixnump object) (not (cl-non-immediate-number-p object))))) + +(defun cl-car-or-pi (object) + (if (consp object) (car object) pi)) + +(defun cl-cdr-or-pi (object) + (if (consp object) (cdr object) pi)) + +(define-compiler-macro equal (&whole form a b) + (if (or (cl-equal-equivalent-to-eq-p (cl-const-expr-val a pi)) + (cl-equal-equivalent-to-eq-p (cl-const-expr-val b pi))) + (cons 'eq (cdr form)) + form)) + +(define-compiler-macro member (&whole form elt list) + (if (or (cl-equal-equivalent-to-eq-p (cl-const-expr-val elt pi)) + (every #'cl-equal-equivalent-to-eq-p + (cl-const-expr-val list '(1.0)))) + (cons 'memq (cdr form)) + form)) + +(define-compiler-macro assoc (&whole form elt list) + (if (or (cl-equal-equivalent-to-eq-p (cl-const-expr-val elt pi)) + (not (find-if-not #'cl-equal-equivalent-to-eq-p + (cl-const-expr-val list '((1.0 . nil))) +:key #'cl-car-or-pi))) + (cons 'assq (cdr form)) + form)) + +(define-compiler-macro rassoc (&whole form elt list) + (if (or (cl-equal-equivalent-to-eq-p (cl-const-expr-val elt pi)) + (not (find-if-not #'cl-equal-equivalent-to-eq-p + (cl-const-expr-val list '((nil . 1.0))) +:key #'cl-cdr-or-pi))) + (cons 'rassq (cdr form)) + form))) + (macrolet ((define-star-compiler-macros (&rest macros) "For `member*', `assoc*' and `rassoc*' with constant ITEM or ＠＠ -3256,12 +3295,12 ＠＠ `(,',equal-function ,item ,list)) ((and (eq test 'eql) (not (eq not-constant item-val))) - (if (cl-non-fixnum-number-p item-val) + (if (cl-non-immediate-number-p item-val) `(,',equal-function ,item ,list) `(,',eq-function ,item ,list))) ((and (eq test 'eql) (not (eq not-constant list-val))) - (if (some 'cl-non-fixnum-number-p list-val) + (if (some 'cl-non-immediate-number-p list-val) `(,',equal-function ,item ,list) ;; This compiler macro used to limit ;; calls to ,,eq-function to lists where ＠＠ -3313,7 +3352,7 ＠＠ ((not-constant '#:not-constant)) (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) - (not (cl-non-fixnum-number-p cl-const-expr-val))) + (not (cl-non-immediate-number-p cl-const-expr-val))) (cons 'delete* (cdr form)) `(delete* ,＠(cdr form) :test #'eq)))) form)) ＠＠ -3336,7 +3375,7 ＠＠ ((not-constant '#:not-constant)) (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) - (not (cl-non-fixnum-number-p cl-const-expr-val))) + (not (cl-non-immediate-number-p cl-const-expr-val))) (cons 'remove* (cdr form)) `(remove* ,＠(cdr form) :test #'eq)))) form)) -- ‘Iodine deficiency was endemic in parts of the UK until, through what has been described as “an unplanned and accidental public health triumph”, iodine was added to cattle feed to improve milk production in the 1930s.’ (EN Pearce, Lancet, June 2011) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches