X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-setf.lisp;h=4ee0528164ab343dce74e2d92e230b78422c0330;hb=b0b168c08b31a748150f404398af754f26fd4813;hp=65b6efb7caeb64d887a8ee1744a46eff7c4a6a6f;hpb=913e06f191acb65c1d99d42234704bec38500ff4;p=sbcl.git

diff --git a/src/code/early-setf.lisp b/src/code/early-setf.lisp
index 65b6efb..4ee0528 100644
--- a/src/code/early-setf.lisp
+++ b/src/code/early-setf.lisp
@@ -47,7 +47,7 @@
 	  ;; Local functions inhibit global SETF methods.
 	  ((and environment
 		(let ((name (car form)))
-		  (dolist (x (sb!c::lexenv-functions environment))
+		  (dolist (x (sb!c::lexenv-funs environment))
 		    (when (and (eq (car x) name)
 			       (not (sb!c::defined-fun-p (cdr x))))
 		      (return t)))))
@@ -101,7 +101,7 @@ GET-SETF-EXPANSION directly."
 				 `(funcall #'(setf ,(car form)))
 				 t))))
 
-(defun get-setf-method-inverse (form inverse setf-function)
+(defun get-setf-method-inverse (form inverse setf-fun)
   (let ((new-var (gensym))
 	(vars nil)
 	(vals nil))
@@ -110,7 +110,7 @@ GET-SETF-EXPANSION directly."
       (push x vals))
     (setq vals (nreverse vals))
     (values vars vals (list new-var)
-	    (if setf-function
+	    (if setf-fun
 		`(,@inverse ,new-var ,@vars)
 		`(,@inverse ,@vars ,new-var))
 	    `(,(car form) ,@vars))))
@@ -174,8 +174,8 @@ GET-SETF-EXPANSION directly."
 	 `(let* ,(nreverse bindlist) ,@(nreverse storelist) ,resultvar))
       (multiple-value-bind (sm1 sm2 sm3 sm4 sm5)
 	  (get-setf-method (first arglist) env)
-	(mapc #'(lambda (var val)
-		  (push `(,var ,val) bindlist))
+	(mapc (lambda (var val)
+		(push `(,var ,val) bindlist))
 	      sm1
 	      sm2)
 	(push `(,lastvar ,sm5) bindlist)
@@ -339,11 +339,6 @@ GET-SETF-EXPANSION directly."
 	  ((not (fboundp `(setf ,name)))
 	   ;; All is well, we don't need any warnings.
 	   (values))
-	  ((info :function :accessor-for name)
-	   (warn "defining SETF macro for DEFSTRUCT slot ~
-		 accessor; redefining as a normal function: ~S"
-		 name)
-	   (proclaim-as-fun-name name))
 	  ((not (eq (symbol-package name) (symbol-package 'aref)))
 	   (style-warn "defining setf macro for ~S when ~S is fbound"
 		       name `(setf ,name))))
@@ -383,13 +378,13 @@ GET-SETF-EXPANSION directly."
 	       `(eval-when (:compile-toplevel :load-toplevel :execute)
 		  (assign-setf-macro
 		   ',access-fn
-		   #'(lambda (,access-form-var ,env-var)
-		       (declare (ignore ,env-var))
-		       (%defsetf ,access-form-var ,(length store-variables)
-				 #'(lambda (,arglist-var)
-				     ,@local-decs
-				     (block ,access-fn
-				       ,body))))
+		   (lambda (,access-form-var ,env-var)
+		     (declare (ignore ,env-var))
+		     (%defsetf ,access-form-var ,(length store-variables)
+			       (lambda (,arglist-var)
+				 ,@local-decs
+				 (block ,access-fn
+				   ,body))))
 		   nil
 		   ',doc))))))
 	(t
@@ -437,9 +432,9 @@ GET-SETF-EXPANSION directly."
 			:environment environment)
       `(eval-when (:compile-toplevel :load-toplevel :execute)
 	 (assign-setf-macro ',access-fn
-			    #'(lambda (,whole ,environment)
-				,@local-decs
-				(block ,access-fn ,body))
+			    (lambda (,whole ,environment)
+			      ,@local-decs
+			      (block ,access-fn ,body))
 			    nil
 			    ',doc)))))