APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1352243526 0 # Node ID 7f4c8574a590f3e3457bdecf5716aa21a64626c8 # Parent 4d15e903800b152c8f2710467d8e0693dd054570 No error from an incorrect number of arguments, recently-added compiler macros lisp/ChangeLog addition: 2012-11-06 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cl-macs.el (equal, member, assoc, rassoc): Never error at compile time in these compiler macros because of an incorrect number of arguments. diff -r 4d15e903800b -r 7f4c8574a590 lisp/ChangeLog --- a/lisp/ChangeLog Tue Nov 06 22:33:58 2012 +0000 +++ b/lisp/ChangeLog Tue Nov 06 23:12:06 2012 +0000 ＠＠ -1,3 +1,9 ＠＠ +2012-11-06 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * cl-macs.el (equal, member, assoc, rassoc): + Never error at compile time in these compiler macros because of an + incorrect number of arguments. + 2012-10-14 Aidan Kehoe <kehoea(a)parhasard.net&gt; * help.el: diff -r 4d15e903800b -r 7f4c8574a590 lisp/cl-macs.el --- 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) -- ‘Liston operated so fast that he once accidentally amputated an assistant’s fingers along with a patient’s leg, […] The patient and the assistant both died of sepsis, and a spectator reportedly died of shock, resulting in the only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches