diff lisp/cl/cl-macs.el @ 134:34a5b81f86ba r20-2b1

Import from CVS: tag r20-2b1
author cvs
date Mon, 13 Aug 2007 09:30:11 +0200
parents dbb370e3c29e
children 538048ae2ab8
line wrap: on
line diff
--- a/lisp/cl/cl-macs.el	Mon Aug 13 09:29:37 2007 +0200
+++ b/lisp/cl/cl-macs.el	Mon Aug 13 09:30:11 2007 +0200
@@ -1737,6 +1737,21 @@
 		(nth 3 method) store-temp)
 	  (list 'substring (nth 4 method) from-temp to-temp))))
 
+(define-setf-method values (&rest args)
+  (let ((methods (mapcar #'(lambda (x)
+			     (get-setf-method x cl-macro-environment))
+			 args))
+	(store-temp (gensym "--values-store--")))
+    (list (apply 'append (mapcar 'first methods))
+	  (apply 'append (mapcar 'second methods))
+	  (list store-temp)
+	  (cons 'list
+		(mapcar #'(lambda (m)
+			    (cl-setf-do-store (cons (car (third m)) (fourth m))
+					      (list 'pop store-temp)))
+			methods))
+	  (cons 'list (mapcar 'fifth methods)))))
+
 ;;; Getting and optimizing setf-methods.
 (defun get-setf-method (place &optional env)
   "Return a list of five values describing the setf-method for PLACE.