From bc8e7bb6cb56bc91090dab67fa35fe93f401c924 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 24 Jun 1993 12:22:27 +0000 Subject: [PATCH] Changed renamed get-setf-method-multiple-value to get-setf-expansion and define-setf-method to define-setf-expander. The old names are also defined for backward compatibility. --- code/macros.lisp | 40 ++++++++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/code/macros.lisp b/code/macros.lisp index b3f6171cb..1a2f1d22f 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.38 1993/05/06 09:56:54 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.39 1993/06/24 12:22:27 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -19,14 +19,16 @@ ;;; (in-package "LISP") (export '(defvar defparameter defconstant when unless setf - defsetf define-setf-method psetf shiftf rotatef push pushnew pop + defsetf psetf shiftf rotatef push pushnew pop incf decf remf case typecase with-open-file with-open-stream with-input-from-string with-output-to-string locally etypecase ctypecase ecase ccase - get-setf-method get-setf-method-multiple-value + get-setf-expansion define-setf-expander define-modify-macro destructuring-bind nth-value otherwise ; Sacred to CASE and related macros. - define-compiler-macro)) + define-compiler-macro + ;; CLtL1 versions: + define-setf-method get-setf-method get-setf-method-multiple-value)) (in-package "EXTENSIONS") (export '(do-anonymous collect iterate)) @@ -188,11 +190,11 @@ name) -;;; And so is DEFINE-SETF-METHOD. +;;; And so is DEFINE-SETF-EXPANDER. (defparameter defsetf-error-string "Setf expander for ~S cannot be called with ~S args.") -(defmacro define-setf-method (access-fn lambda-list &body body) +(defmacro define-setf-expander (access-fn lambda-list &body body) "Syntax like DEFMACRO, but creates a Setf-Method generator. The body must be a form that returns the five magical values." (unless (symbolp access-fn) @@ -214,6 +216,10 @@ nil ',doc))))) +(defmacro define-setf-method (&rest stuff) + "Obsolete, use define-setf-expander." + `(define-setf-expander ,@stuff)) + ;;; %DEFINE-SETF-MACRO -- Internal ;;; @@ -520,7 +526,7 @@ ;;; of value forms, a list of the single store-value form, a storing function, ;;; and an accessing function. -(defun get-setf-method-multiple-value (form &optional environment) +(defun get-setf-expansion (form &optional environment) "Returns five values needed by the SETF machinery: a list of temporary variables, a list of values with which to fill them, a list of temporaries for the new values, the setting function, and the accessing function." @@ -530,7 +536,7 @@ (expansion expanded) (macroexpand-1 form environment) (if expanded - (get-setf-method-multiple-value expansion environment) + (get-setf-expansion expansion environment) (let ((new-var (gensym))) (values nil nil (list new-var) `(setq ,form ,new-var) form))))) @@ -550,6 +556,9 @@ (t (expand-or-get-setf-inverse form environment))))) +(defun get-setf-method-multiple-value (form &optional env) + "Obsolete: use GET-SETF-EXPANSION." + (get-setf-expansion form env)) ;;; ;;; If a macro, expand one level and try again. If not, go for the @@ -559,7 +568,7 @@ (expansion expanded) (macroexpand-1 form environment) (if expanded - (get-setf-method-multiple-value expansion environment) + (get-setf-expansion expansion environment) (get-setf-method-inverse form `(funcall #'(setf ,(car form))) t)))) @@ -580,11 +589,10 @@ (defun get-setf-method (form &optional environment) - "Like Get-Setf-Method-Multiple-Value, but signal an error if there are - more than one new-value variables." + "Obsolete: use GET-SETF-EXPANSION and handle multiple store values." (multiple-value-bind (temps value-forms store-vars store-form access-form) - (get-setf-method-multiple-value form environment) + (get-setf-expansion form environment) (when (cdr store-vars) (error "GET-SETF-METHOD used for a form with multiple store ~ variables:~% ~S" form)) @@ -680,7 +688,7 @@ (if (atom place) `(setq ,place ,value-form) (multiple-value-bind (dummies vals newval setter getter) - (get-setf-method-multiple-value place env) + (get-setf-expansion place env) (declare (ignore getter)) (let ((inverse (info setf inverse (car place)))) (if (and inverse (eq inverse (car setter))) @@ -707,7 +715,7 @@ (error "Odd number of args to PSETF.")) (multiple-value-bind (dummies vals newval setter getter) - (get-setf-method-multiple-value (car a) env) + (get-setf-expansion (car a) env) (declare (ignore getter)) (let*-bindings (mapcar #'list dummies vals)) (mv-bindings (list newval (cadr a))) @@ -738,7 +746,7 @@ ,prev-setter))) (multiple-value-bind (temps exprs store-vars setter getter) - (get-setf-method-multiple-value (car a) env) + (get-setf-expansion (car a) env) (loop for temp in temps for expr in exprs @@ -763,7 +771,7 @@ (dolist (arg args) (multiple-value-bind (temps subforms store-vars setter getter) - (get-setf-method-multiple-value arg env) + (get-setf-expansion arg env) (loop for temp in temps for subform in subforms -- GitLab