[mcclim-cvs] CVS update: mcclim/Extensions/conditional-commands/creating-assoc.lisp

[Max-Gerd Retzlaff]

Update of /project/mcclim/cvsroot/mcclim/Extensions/conditional-commands
In directory common-lisp.net:/tmp/cvs-serv13488

Modified Files:
	creating-assoc.lisp 
Log Message:
Remove the old and uncommented versions of CREATING-ASSOC.

Date: Thu Nov 24 19:37:12 2005
Author: mretzlaff

Index: mcclim/Extensions/conditional-commands/creating-assoc.lisp
diff -u mcclim/Extensions/conditional-commands/creating-assoc.lisp:1.1 mcclim/Extensions/conditional-commands/creating-assoc.lisp:1.2
--- mcclim/Extensions/conditional-commands/creating-assoc.lisp:1.1	Thu Nov 24 19:35:34 2005
+++ mcclim/Extensions/conditional-commands/creating-assoc.lisp	Thu Nov 24 19:37:12 2005
@@ -1,80 +1,5 @@
 (in-package :creating-assoc)
 
-;;; Doesn't work:
-;;;
-;;; (defun creating-assoc (item alist)
-;;;   "assoc that creates the requested alist item on-the-fly if not yet existing"
-;;;   (let ((item-assoc (assoc item alist)))
-;;;     (unless item-assoc
-;;;       (let ((new-item (list item)))
-;;;         (push new-item alist)
-;;;         (setf item-assoc new-item)))))
-
-;;; Doesn't work:
-;;;
-;;; (defmacro creating-assoc (item alist)
-;;;   "assoc that creates the requested alist item on-the-fly if not yet existing"
-;;;   (let ((entry (gensym "entry-"))
-;;;         (new-item (gensym "new-item-"))
-;;;         (the-item (gensym "the-item-"))
-;;;         (the-alist (gensym "the-alist-")))
-;;;     `(let* ((,the-item ,item)
-;;;             (,the-alist ,alist)
-;;;             (,entry (assoc ,the-item ,the-alist)))
-;;;        (unless ,entry
-;;;          (let ((,new-item (list ,the-item)))
-;;;            (push ,new-item ,the-alist)
-;;;            (setf ,entry ,new-item))))))
-
-;;; Does work, but ALIST will be evaluated twice:
-;;;
-;;; (defmacro creating-assoc (item alist)
-;;;   "assoc that creates the requested alist item on-the-fly if not yet existing"
-;;;   (let ((entry (gensym "entry-"))
-;;;         (new-item (gensym "new-item-"))
-;;;         (the-item (gensym "the-item-")))
-;;;     `(let* ((,the-item ,item)
-;;;             (,entry (assoc ,the-item ,alist)))
-;;;        (unless ,entry
-;;;          (let ((,new-item (list ,the-item)))
-;;;            (push ,new-item ,alist)
-;;;            (setf ,entry ,new-item))))))
-
-;;; From SBCL source, uses GET-SETF-METHOD, a relic from pre-ANSI Common Lisp:
-;;;
-;;; (defmacro-mundanely push (obj place &environment env)
-;;;   #!+sb-doc
-;;;   "Takes an object and a location holding a list. Conses the object onto
-;;;   the list, returning the modified list. OBJ is evaluated before PLACE."
-;;;   (multiple-value-bind (dummies vals newval setter getter)
-;;;       (get-setf-method place env)
-;;;     (let ((g (gensym)))
-;;;       `(let* ((,g ,obj)
-;;;               ,@(mapcar #'list dummies vals)
-;;;               (,(car newval) (cons ,g ,getter)))
-;;;          ,setter))))
-
-;;; Example CLHS page on GET-SETF-EXPANSION:
-;;; (Notice that there is an error, "(if (cdr new)" should be replaced by "(if (cdr ,(car new))".)
-;;;
-;;;  (defmacro xpop (place &environment env)
-;;;    (multiple-value-bind (dummies vals new setter getter)
-;;;                         (get-setf-expansion place env)
-;;;       `(let* (,@(mapcar #'list dummies vals) (,(car new) ,getter))
-;;;          (if (cdr new) (error "Can't expand this."))
-;;;          (prog1 (car ,(car new))
-;;;                 (setq ,(car new) (cdr ,(car new)))
-;;;                 ,setter))))
-
-;;; New version, still does not work:
-;;;
-;;; (defun creating-assoc (item alist)
-;;;   "assoc that creates the requested alist item on-the-fly if not yet existing"
-;;;   (or (assoc item alist)
-;;;       (first (push (list item) alist))))
-
-;;; Macro based on the new (not-working) defun, works and is nice:
-;;;
 (defmacro creating-assoc (item alist &environment env)
   "assoc that creates the requested alist item on-the-fly if not yet existing"
    (multiple-value-bind (dummies vals new setter getter)