X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fmethods.lisp;h=d6559bc893dfb258637248585b029f1ed685cce3;hb=683874b497a99cd2c11b6c5d9b47e2785b1ede5f;hp=a95c72edd2bbc596ee084f063688487b9e084671;hpb=39ca94ec421224c78cb01f7d2d7b49321c66a2d4;p=sbcl.git

diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index a95c72e..d6559bc 100644
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -23,22 +23,6 @@
 
 (in-package "SB-PCL")
 
-(defmethod shared-initialize :after ((slotd standard-slot-definition)
-				     slot-names &key)
-  (declare (ignore slot-names))
-  (with-slots (allocation class)
-    slotd
-    (setq allocation (if (eq allocation :class) class allocation))))
-
-(defmethod shared-initialize :after ((slotd structure-slot-definition)
-				     slot-names
-				     &key (allocation :instance))
-  (declare (ignore slot-names))
-  (unless (eq allocation :instance)
-    (error "Structure slots must have :INSTANCE allocation.")))
-
-(defmethod inform-type-system-about-class ((class structure-class) (name t))
-  nil)
 
 ;;; methods
 ;;;
@@ -221,7 +205,7 @@
 		   lambda-list lambda-list-p))
 
   (when namep
-    (set-function-name generic-function name))
+    (set-fun-name generic-function name))
 
   (flet ((initarg-error (initarg value string)
 	   (error "when initializing the generic function ~S:~%~
@@ -396,10 +380,11 @@
     ;; in the usual sort of way. For efficiency don't bother to
     ;; keep specialized-argument-positions sorted, rather depend
     ;; on our caller to do that.
-    (iterate ((type-spec (list-elements (method-specializers method)))
-	      (pos (interval :from 0)))
-      (unless (eq type-spec *the-class-t*)
-	(pushnew pos specialized-argument-positions)))
+    (let ((pos 0))
+      (dolist (type-spec (method-specializers method))
+        (unless (eq type-spec *the-class-t*)
+          (pushnew pos specialized-argument-positions))
+        (incf pos)))
     ;; Finally merge the values for this method into the values
     ;; for the exisiting methods and return them. Note that if
     ;; num-of-requireds is NIL it means this is the first method
@@ -410,10 +395,11 @@
 	    specialized-argument-positions)))
 
 (defun make-discriminating-function-arglist (number-required-arguments restp)
-  (nconc (gathering ((args (collecting)))
-	   (iterate ((i (interval :from 0 :below number-required-arguments)))
-	     (gather (intern (format nil "Discriminating Function Arg ~D" i))
-		     args)))
+  (nconc (let ((args nil))
+           (dotimes (i number-required-arguments)
+             (push (intern (format nil "Discriminating Function Arg ~D" i))
+                   args))
+           (nreverse args))
 	 (when restp
 	       `(&rest ,(intern "Discriminating Function &rest Arg")))))
 
@@ -605,7 +591,7 @@
 
 
 (defun error-need-at-least-n-args (function n)
-  (error "~@<The function ~2I~_~S ~I~_requires at least ~D argument~:P.~:>"
+  (error "~@<The function ~2I~_~S ~I~_requires at least ~W argument~:P.~:>"
 	 function
 	 n))
 
@@ -1305,8 +1291,7 @@
 		(if function-p
 		    function
 		    (make-fast-method-call
-		     :function (set-function-name function
-						  `(sdfun-method ,name))
+		     :function (set-fun-name function `(sdfun-method ,name))
 		     :arg-info fmc-arg-info))))))))))
 
 (defvar *show-make-unordered-methods-emf-calls* nil)
@@ -1337,7 +1322,7 @@
 ;;; argument <gf1>, and returns a result <df1>, that result must not be
 ;;; passed to apply or funcall directly. Rather, <df1> must be stored as
 ;;; the funcallable instance function of the same generic function <gf1>
-;;; (using set-funcallable-instance-function). Then the generic function
+;;; (using set-funcallable-instance-fun). Then the generic function
 ;;; can be passed to funcall or apply.
 ;;;
 ;;; An important exception is that methods on this generic function are
@@ -1379,7 +1364,7 @@
 ;;;     #'(lambda (arg)
 ;;;	 (cond (<some condition>
 ;;;		<store some info in the generic function>
-;;;		(set-funcallable-instance-function
+;;;		(set-funcallable-instance-fun
 ;;;		  gf
 ;;;		  (compute-discriminating-function gf))
 ;;;		(funcall gf arg))
@@ -1391,7 +1376,7 @@
 ;;;   (defmethod compute-discriminating-function ((gf my-generic-function))
 ;;;     #'(lambda (arg)
 ;;;	 (cond (<some condition>
-;;;		(set-funcallable-instance-function
+;;;		(set-funcallable-instance-fun
 ;;;		  gf
 ;;;		  #'(lambda (a) ..))
 ;;;		(funcall gf arg))