(let (temp)
(cond ((symbolp form)
(multiple-value-bind (expansion expanded)
- (sb!xc:macroexpand-1 form environment)
+ (%macroexpand-1 form environment)
(if expanded
(sb!xc:get-setf-expansion expansion environment)
(let ((new-var (sb!xc:gensym "NEW")))
expand-or-get-setf-inverse))
(defun expand-or-get-setf-inverse (form environment)
(multiple-value-bind (expansion expanded)
- (sb!xc:macroexpand-1 form environment)
+ (%macroexpand-1 form environment)
(if expanded
(sb!xc:get-setf-expansion expansion environment)
(get-setf-method-inverse form
#!+sb-doc
"Associates a SETF update function or macro with the specified access
function or macro. The format is complex. See the manual for details."
- (cond ((not (listp (car rest)))
+ (cond ((and (not (listp (car rest))) (symbolp (car rest)))
`(eval-when (:load-toplevel :compile-toplevel :execute)
(assign-setf-macro ',access-fn
nil
,gnuval)
`(mask-field ,btemp ,getter)))))
-(sb!xc:define-setf-expander the (type place &environment env)
+(defun setf-expand-the (the type place env)
(declare (type sb!c::lexenv env))
(multiple-value-bind (temps subforms store-vars setter getter)
(sb!xc:get-setf-expansion place env)
(values temps subforms store-vars
`(multiple-value-bind ,store-vars
- (the ,type (values ,@store-vars))
+ (,the ,type (values ,@store-vars))
,setter)
- `(the ,type ,getter))))
+ `(,the ,type ,getter))))
+
+(sb!xc:define-setf-expander the (type place &environment env)
+ (setf-expand-the 'the type place env))
+
+(sb!xc:define-setf-expander truly-the (type place &environment env)
+ (setf-expand-the 'truly-the type place env))