[alexandria-devel] cdr assoc (now called alist-get)

[John Fremlin]

For http://common-lisp.net/project/cl-irregsexp/ and in fact for many 
other projects, it is quite handy to have a way of storing key value 
pairs in a table that is more lightweight than a hashtable, and that 
preserves ordering.

The obvious way to do it in Lisp is to store a list like '((key0 . 
value0) (key1 . value1) ...)

However in the ANSI standard there is no easy way to implement (setf 
(gethash key table) value).

(cdr (assoc ...)) is sufficient for lookup.

To that end there is commonly available in extensions a (setf 
cdr-assoc). I posted one to the list before but I had managed to mangle 
it utterly in my last edit of it and it didn't work.

I hope that was why you Alexandrians ignored me . . .

Anyway, one problem with cdr-assoc is that the order of parameters is 
apparently non-standard. To alleviate this problem I have come back with 
a new name, alist-get and also ralist-get (for cdr-rassoc, the 
(value.key) convention).

Feedback very much appreciated!



(declaim (inline racons))
(defun racons (key value ralist)
   (acons value key ralist))


(macrolet ((define-alist-get (name get-pair get-value-from-pair add)
	     `(progn
		(declaim (inline ,name))
		(defun ,name (alist key &key (test 'eql))
		  (let ((pair (,get-pair key alist :test test)))
		    (values (,get-value-from-pair pair) pair)))
		(define-setf-expander ,name (place key &key (test ''eql)
					     &environment env)
		  (multiple-value-bind (dummies vals newvals setter getter)
		      (get-setf-expansion place env)
		    (when (cdr newvals)
		      (error "~A cannot store multiple values in one place" ',name))
		    (with-unique-names (store key-val test-val alist found)
		      (values
		       `(, at dummies ,key-val ,test-val)
		       `(, at vals ,key ,test)
		       (list store)
		       `(let ((,alist ,getter))
			  (let ((,found (,',get-pair ,key-val ,alist :test ,test-val)))
			    (cond (,found
				   (setf (,',get-value-from-pair ,found) ,store))
				  (t
				   (let ,newvals
				     (setf ,(first newvals) (,',add ,key ,store ,alist))
				     ,setter)))
			    ,store))
		       `(,',name ,getter ,key))))))))
   (define-alist-get alist-get assoc cdr acons)
   (define-alist-get ralist-get rassoc car racons))