emacs-pretest-bug
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: emacs-lisp/cl.el (pushnew): void-variable x


From: Miles Bader
Subject: Re: emacs-lisp/cl.el (pushnew): void-variable x
Date: Thu, 21 Sep 2006 10:51:50 +0900

address@hidden (Kim F. Storm) writes:
> I have added new primitive memql, and modified pushnew and member* to use it.

Er, well Richard said to wait until after the release, but ...

I think your change to pushnew is wrong -- it evaluates the value twice.

A change to `pushnew' is not necessary anyway: for simple cases (a value
with no side-effects), the change to `member*' is enough to do the job,
so `pushnew' itself can just be reverted to what it was before Richard's
change (just calling adjoin).

[Non-simple cases can easily be handled as well by making the `adjoin'
compiler-macro bind the value when it's non-simple.]

-Miles



--- orig/lisp/emacs-lisp/cl-macs.el
+++ mod/lisp/emacs-lisp/cl-macs.el
@@ -2606,9 +2592,18 @@
          (t form))))
 
 (define-compiler-macro adjoin (&whole form a list &rest keys)
-  (if (and (cl-simple-expr-p a) (cl-simple-expr-p list)
-          (not (memq :key keys)))
-      (list 'if (list* 'member* a list keys) list (list 'cons a list))
+  (if (and (cl-simple-expr-p list) (not (memq :key keys)))
+      (if (cl-simple-expr-p a) 
+         (list 'if (list* 'member* a list keys) list (list 'cons a list))
+       (let ((test (and (= (length keys) 2) (eq (car keys) :test)
+                        (cl-const-expr-val (nth 1 keys)))))
+         (if (or (null keys) (memq test '(eql eq equal)))
+             (let ((a-var (make-symbol "--cl-var--")))
+               `(let ((,a-var ,a))
+                  (if (member* ,a-var ,list ,@keys)
+                      ,list
+                    (cons ,a-var ,list))))
+           form)))
     form))
 
 (define-compiler-macro list* (arg &rest others)


--- orig/lisp/emacs-lisp/cl.el
+++ mod/lisp/emacs-lisp/cl.el
@@ -149,20 +149,13 @@
   (if (symbolp place) (list 'setq place (list 'cons x place))
     (list 'callf2 'cons x place)))
 
-(defvar pushnew-internal)
-
 (defmacro pushnew (x place &rest keys)
   "(pushnew X PLACE): insert X at the head of the list if not already there.
 Like (push X PLACE), except that the list is unmodified if X is `eql' to
 an element already on the list.
 \nKeywords supported:  :test :test-not :key
 \n(fn X PLACE [KEYWORD VALUE]...)"
-  (if (symbolp place)
-      (if (null keys)
-         `(let ((pushnew-internal ,place))
-            (add-to-list 'pushnew-internal ,x nil 'eql)
-            (setq ,place pushnew-internal))
-       (list 'setq place (list* 'adjoin x place keys)))
+  (if (symbolp place) (list 'setq place (list* 'adjoin x place keys))
     (list* 'callf2 'adjoin x place keys)))
 
 (defun cl-set-elt (seq n val)


-Miles
-- 
My books focus on timeless truths.  -- Donald Knuth




reply via email to

[Prev in Thread] Current Thread [Next in Thread]