From 715977f8b04160f7127f96731dfd9a2b194e2f6e Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Fri, 1 Nov 2002 17:41:53 +0000 Subject: [PATCH] The previous checkin adding multiple-values support to push and pushnew screwed up the evaluation order. Fix that, and get the evaluation order correct for multiple-values too. --- code/macros.lisp | 64 ++++++++++++++++++++++++++++++++++-------------- 1 file changed, 45 insertions(+), 19 deletions(-) diff --git a/code/macros.lisp b/code/macros.lisp index 6052faf28..0cafaeb5b 100644 --- a/code/macros.lisp +++ b/code/macros.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.78 2002/10/30 18:08:32 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.79 2002/11/01 17:41:53 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -894,15 +894,28 @@ `(setq ,place (cons ,obj ,place)) (multiple-value-bind (dummies vals newval setter getter) (get-setf-expansion place env) - ;; Handle multiple values - `(let* (,@(mapcar #'list dummies vals)) - (multiple-value-bind ,newval - ,(if (cdr newval) - `(values ,@(rest (mapcar #'(lambda (a b) - (list 'cons a b)) - obj getter))) - `(cons ,obj ,getter)) - ,setter))))) + (cond + ((cdr newval) + ;; Handle multiple values + (let ((g (mapcar #'(lambda (x) + (declare (ignore x)) + (gensym)) + (rest obj)))) + `(multiple-value-bind ,g + ,obj + (let* (,@(mapcar #'list dummies vals)) + (multiple-value-bind ,newval + (values ,@(mapcar #'(lambda (a b) + (list 'cons a b)) + g (rest getter))) + ,setter))))) + (t + ;; A single value + (let ((g (gensym))) + `(let* ((,g ,obj) + ,@(mapcar #'list dummies vals) + (,@newval (cons ,g ,getter))) + ,setter))))))) (defmacro pushnew (obj place &rest keys &environment env) "Takes an object and a location holding a list. If the object is already @@ -913,15 +926,28 @@ `(setq ,place (adjoin ,obj ,place ,@keys)) (multiple-value-bind (vars vals stores setter getter) (get-setf-expansion place env) - `(let* (,@(mapcar #'list vars vals)) - (multiple-value-bind ,stores - ,(if (cdr stores) - `(values ,@(rest (mapcar #'(lambda (a b) - `(adjoin ,a ,b ,@keys)) - obj getter))) - `(adjoin ,obj ,getter ,@keys)) - ,setter))))) - + (cond + ((cdr stores) + ;; Multiple values + (let ((g (mapcar #'(lambda (x) + (declare (ignore x)) + (gensym)) + (rest obj)))) + `(multiple-value-bind ,g + ,obj + (let* (,@(mapcar #'list vars vals)) + (multiple-value-bind ,stores + (values ,@(mapcar #'(lambda (a b) + `(adjoin ,a ,b ,@keys)) + g (rest getter))) + ,setter))))) + (t + ;; Single value + (let ((g (gensym))) + `(let* ((,g ,obj) + ,@(mapcar #'list vars vals) + (,@stores (adjoin ,g ,getter ,@keys))) + ,setter))))))) (defmacro pop (place &environment env) "The argument is a location holding a list. Pops one item off the front -- GitLab