X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-setf.lisp;h=ee40cbd251fa2c0673e62210fe290ce6e43f123c;hb=da8cb4801a3ab35070f380e22aea3d260f9df8aa;hp=c55cf6aa69d20f438f7408688c65519963cb5484;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/code/early-setf.lisp b/src/code/early-setf.lisp index c55cf6a..ee40cbd 100644 --- a/src/code/early-setf.lisp +++ b/src/code/early-setf.lisp @@ -307,8 +307,9 @@ GET-SETF-EXPANSION directly." "Creates a new read-modify-write macro like PUSH or INCF." (let ((other-args nil) (rest-arg nil) - (env (gensym)) - (reference (gensym))) + (env (make-symbol "ENV")) ; To beautify resulting arglist. + (reference (make-symbol "PLACE"))) ; Note that these will be nonexistent + ; in the final expansion anyway. ;; Parse out the variable names and &REST arg from the lambda list. (do ((ll lambda-list (cdr ll)) (arg nil)) @@ -393,21 +394,21 @@ GET-SETF-EXPANSION directly." (destructuring-bind (lambda-list (&rest store-variables) &body body) rest - (let ((arglist-var (gensym "ARGS-")) + (let ((whole-var (gensym "WHOLE-")) (access-form-var (gensym "ACCESS-FORM-")) (env-var (gensym "ENVIRONMENT-"))) (multiple-value-bind (body local-decs doc) (parse-defmacro `(,lambda-list ,@store-variables) - arglist-var body access-fn 'defsetf + whole-var body access-fn 'defsetf + :environment env-var :anonymousp t) `(eval-when (:compile-toplevel :load-toplevel :execute) (assign-setf-macro ',access-fn (lambda (,access-form-var ,env-var) - (declare (ignore ,env-var)) + ,@local-decs (%defsetf ,access-form-var ,(length store-variables) - (lambda (,arglist-var) - ,@local-decs + (lambda (,whole-var) ,body))) nil ',doc))))))