From 632c6b8c1e85b514b56a6776caa14e8fd253800c Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 6 May 1993 09:56:54 +0000 Subject: [PATCH] Really really fixed get-setf-method-multiple-value for local macros. Also, in the recursive calls, people were not propagating the environment through, and in some places were not recursing with the multiple-value version. --- code/macros.lisp | 35 ++++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/code/macros.lisp b/code/macros.lisp index 00145e8d2..b3f6171cb 100644 --- a/code/macros.lisp +++ b/code/macros.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.37 1993/03/01 20:11:18 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.38 1993/05/06 09:56:54 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -510,11 +510,11 @@ ;;; The inverse for a generalized-variable reference function is stored in ;;; one of two ways: ;;; -;;; A SETF-INVERSE property corresponds to the short form of DEFSETF. It is +;;; A SETF inverse property corresponds to the short form of DEFSETF. It is ;;; the name of a function takes the same args as the reference form, plus a ;;; new-value arg at the end. ;;; -;;; A SETF-METHOD-EXPANDER property is created by the long form of DEFSETF or +;;; A SETF method expander is created by the long form of DEFSETF or ;;; by DEFINE-SETF-METHOD. It is a function that is called on the reference ;;; form and that produces five values: a list of temporary variables, a list ;;; of value forms, a list of the single store-value form, a storing function, @@ -530,7 +530,7 @@ (expansion expanded) (macroexpand-1 form environment) (if expanded - (get-setf-method-multiple-value expansion) + (get-setf-method-multiple-value expansion environment) (let ((new-var (gensym))) (values nil nil (list new-var) `(setq ,form ,new-var) form))))) @@ -542,22 +542,27 @@ (when (and (eq (car x) name) (not (c::defined-function-p (cdr x)))) (return t))))) - (get-setf-method-inverse form `(funcall #'(setf ,(car form))) t)) + (expand-or-get-setf-inverse form environment)) ((setq temp (info setf inverse (car form))) (get-setf-method-inverse form `(,temp) nil)) ((setq temp (info setf expander (car form))) (funcall temp form environment)) - ;; - ;; If a macro, expand one level and try again. If not, go for the - ;; SETF function. (t - (multiple-value-bind (res win) - (macroexpand-1 form environment) - (if win - (get-setf-method res environment) - (get-setf-method-inverse form - `(funcall #'(setf ,(car form))) - t))))))) + (expand-or-get-setf-inverse form environment))))) + + +;;; +;;; If a macro, expand one level and try again. If not, go for the +;;; SETF function. +(defun expand-or-get-setf-inverse (form environment) + (multiple-value-bind + (expansion expanded) + (macroexpand-1 form environment) + (if expanded + (get-setf-method-multiple-value expansion environment) + (get-setf-method-inverse form `(funcall #'(setf ,(car form))) + t)))) + (defun get-setf-method-inverse (form inverse setf-function) (let ((new-var (gensym)) -- GitLab