- (multiple-value-bind (expansion expanded)
- (sb!xc:macroexpand-1 form environment)
- (if expanded
- (sb!xc:get-setf-expansion expansion environment)
- (let ((new-var (gensym)))
- (values nil nil (list new-var)
- `(setq ,form ,new-var) form)))))
- ;; Local functions inhibit global SETF methods.
- ((and environment
- (let ((name (car form)))
- (dolist (x (sb!c::lexenv-functions environment))
- (when (and (eq (car x) name)
- (not (sb!c::defined-function-p (cdr x))))
- (return 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)))
- ;; KLUDGE: It may seem as though this should go through
- ;; *MACROEXPAND-HOOK*, but the ANSI spec seems fairly explicit
- ;; that *MACROEXPAND-HOOK* is a hook for MACROEXPAND-1, not
- ;; for macroexpansion in general. -- WHN 19991128
- (funcall temp
- form
- ;; As near as I can tell from the ANSI spec, macroexpanders
- ;; have a right to expect an actual lexical environment,
- ;; not just a NIL which is to be interpreted as a null
- ;; lexical environment. -- WHN 19991128
- (or environment (make-null-lexenv))))
- (t
- (expand-or-get-setf-inverse form environment)))))
-
-;;; GET-SETF-METHOD existed in pre-ANSI Common Lisp, and various code inherited
-;;; from CMU CL uses it repeatedly, so rather than rewrite a lot of code to not
-;;; use it, we just define it in terms of ANSI's GET-SETF-EXPANSION (or
-;;; actually, the cross-compiler version of that, i.e.
-;;; SB!XC:GET-SETF-EXPANSION).
-(declaim (ftype (function (t &optional (or null sb!c::lexenv))) get-setf-method))
-(defun get-setf-method (form &optional environment)
- #!+sb-doc
- "This is a specialized-for-one-value version of GET-SETF-EXPANSION (and
-a relic from pre-ANSI Common Lisp). Portable ANSI code should use
-GET-SETF-EXPANSION directly."
- (multiple-value-bind (temps value-forms store-vars store-form access-form)
- (sb!xc:get-setf-expansion form environment)
- (when (cdr store-vars)
- (error "GET-SETF-METHOD used for a form with multiple store ~
- variables:~% ~S"
- form))
- (values temps value-forms store-vars store-form access-form)))
+ (multiple-value-bind (expansion expanded)
+ (%macroexpand-1 form environment)
+ (if expanded
+ (sb!xc:get-setf-expansion expansion environment)
+ (let ((new-var (sb!xc:gensym "NEW")))
+ (values nil nil (list new-var)
+ `(setq ,form ,new-var) form)))))
+ ;; Local functions inhibit global SETF methods.
+ ((and environment
+ (let ((name (car form)))
+ (dolist (x (sb!c::lexenv-funs environment))
+ (when (and (eq (car x) name)
+ (not (sb!c::defined-fun-p (cdr x))))
+ (return t)))))
+ (expand-or-get-setf-inverse form environment))
+ ((setq temp (info :setf :inverse (car form)))
+ (get-setf-method-inverse form `(,temp) nil environment))
+ ((setq temp (info :setf :expander (car form)))
+ ;; KLUDGE: It may seem as though this should go through
+ ;; *MACROEXPAND-HOOK*, but the ANSI spec seems fairly explicit
+ ;; that *MACROEXPAND-HOOK* is a hook for MACROEXPAND-1, not
+ ;; for macroexpansion in general. -- WHN 19991128
+ (funcall temp
+ form
+ ;; As near as I can tell from the ANSI spec,
+ ;; macroexpanders have a right to expect an actual
+ ;; lexical environment, not just a NIL which is to
+ ;; be interpreted as a null lexical environment.
+ ;; -- WHN 19991128
+ (coerce-to-lexenv environment)))
+ (t
+ (expand-or-get-setf-inverse form environment)))))