Commits

Aidan Kehoe committed e63bb7b

Add compiler macros for #'equal, #'member, ... where #'eq, #'memq appropriate.

lisp/ChangeLog addition:

2012-05-07 Aidan Kehoe <kehoea@parhasard.net>

* 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.

  • Participants
  • Parent commits 289cf21

Comments (0)

Files changed (2)

 	(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@parhasard.net>
+
+	* 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@parhasard.net>
 
 	* byte-optimize.el (byte-optimize-form-code-walker):
     ((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))
 (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
                                  `(,',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
           ((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))
           ((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))