Mercurial > hg > xemacs-beta

diff lisp/cl-macs.el @ 5694:7f4c8574a590

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
No error from an incorrect number of arguments, recently-added compiler macros lisp/ChangeLog addition: 2012-11-06 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (equal, member, assoc, rassoc): Never error at compile time in these compiler macros because of an incorrect number of arguments.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 06 Nov 2012 23:12:06 +0000
parents 796f2a8fdced
children 165315eae1ab
line wrap: on
line diff
--- a/lisp/cl-macs.el	Tue Nov 06 22:33:58 2012 +0000
+++ b/lisp/cl-macs.el	Tue Nov 06 23:12:06 2012 +0000
@@ -3238,34 +3238,46 @@
 (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)))
+(define-compiler-macro equal (&whole form &rest args)
+  (cond
+   ((not (eql (length form) 3))
+    form)
+   ((or (cl-equal-equivalent-to-eq-p (cl-const-expr-val (pop args) pi))
+        (cl-equal-equivalent-to-eq-p (cl-const-expr-val (pop args) pi)))
+    (cons 'eq (cdr form)))
+   (t form)))
+
+(define-compiler-macro member (&whole form &rest args)
+  (cond
+   ((not (eql (length form) 3))
+    form)
+   ((or (cl-equal-equivalent-to-eq-p (cl-const-expr-val (pop args) pi))
+        (every #'cl-equal-equivalent-to-eq-p
+               (cl-const-expr-val (pop args) '(1.0))))
+    (cons 'memq (cdr form)))
+   (t form)))
+
+(define-compiler-macro assoc (&whole form &rest args)
+  (cond
+   ((not (eql (length form) 3))
+    form)
+   ((or (cl-equal-equivalent-to-eq-p (cl-const-expr-val (pop args) pi))
+        (not (find-if-not #'cl-equal-equivalent-to-eq-p
+                          (cl-const-expr-val (pop args) '((1.0 . nil)))
+                          :key #'cl-car-or-pi)))
+    (cons 'assq (cdr form)))
+   (t form)))
+
+(define-compiler-macro rassoc (&whole form &rest args)
+  (cond
+   ((not (eql (length form) 3))
+    form)
+   ((or (cl-equal-equivalent-to-eq-p (cl-const-expr-val (pop args) pi))
+        (not (find-if-not #'cl-equal-equivalent-to-eq-p
+                            (cl-const-expr-val (pop args) '((nil . 1.0)))
                             :key #'cl-cdr-or-pi)))
-      (cons 'rassq (cdr form))
-    form))
+    (cons 'rassq (cdr form)))
+   (t form)))
 
 (macrolet
     ((define-star-compiler-macros (&rest macros)