X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fmacros.lisp;h=2add735d9fe6e264d79bb1d2924eddecde7bb695;hb=40bf78b47ea89b15698adb9c550efa4cbacafeb7;hp=b0c5f53fc71980667d12a3b0f80bf86cab3fcf24;hpb=24bc431a3403af05c5df601d09c0d0c27cb500b2;p=sbcl.git

diff --git a/src/pcl/macros.lisp b/src/pcl/macros.lisp
index b0c5f53..2add735 100644
--- a/src/pcl/macros.lisp
+++ b/src/pcl/macros.lisp
@@ -180,13 +180,7 @@
 	  (when (and new-value (class-wrapper new-value))
 	    (setf (find-class-cell-predicate cell)
 		  (fdefinition (class-predicate-name new-value))))
-	  (when (and new-value (not (forward-referenced-class-p new-value)))
-
-	    (dolist (keys+aok (find-class-cell-make-instance-function-keys
-			       cell))
-	      (update-initialize-info-internal
-	       (initialize-info new-value (car keys+aok) nil (cdr keys+aok))
-	       'make-instance-function))))
+	  (update-ctors 'setf-find-class :class new-value :name symbol))
 	new-value)
       (error "~S is not a legal class name." symbol)))
 
@@ -216,66 +210,4 @@
 
 (defsetf slot-value set-slot-value)
 
-(defun misplaced-lambda-list-keyword (lambda-list keyword)
-  (error "Lambda list keyword ~S is misplaced in ~S." keyword lambda-list))
-
-(defmacro process-lambda-list (lambda-list &rest clauses)
-  ;; (process-lambda-list '(a b &optional (c 1))
-  ;;                      (&required)
-  ;;                      ((&optional (print "Started processing optional arguments"))
-  ;;                       (format "Optional argument: ~S~%" it))
-  ;;                      (&rest (print "Rest")))
-  (let ((clauses (loop for clause in clauses
-                    collect
-                      (cond ((symbolp (car clause))
-                             `(,(car clause) nil . ,(cdr clause)))
-                            ((consp (car clause))
-                             `(,(caar clause) ,(cdar clause) . ,(cdr clause)))
-                            (t (error "Invalid clause format: ~S." clause)))))
-        (ll (gensym "LL"))
-        (state (gensym "STATE"))
-        (restp (gensym "RESTP"))
-        (check-state (gensym "CHECK-STATE")))
-    `(let ((,ll ,lambda-list)
-           (,state '&required)
-           (,restp nil))
-       (dolist (it ,ll)
-         (flet ((,check-state (possible)
-                  (unless (memq ,state possible)
-                    (misplaced-lambda-list-keyword ,ll it))))
-           (cond ((memq it lambda-list-keywords)
-                  (case it
-                    (&optional (,check-state '(&required))
-                               ,@(cadr (assoc '&optional clauses)))
-                    (&rest (,check-state '(&required &optional))
-                           ,@(cadr (assoc '&rest clauses)))
-                    (&key (,check-state '(&required &optional &rest))
-                          (when (and (eq ,state '&rest)
-                                     (not ,restp))
-                            (error "Omitted &REST variable in ~S." ,ll))
-                          ,@(cadr (assoc '&key clauses)))
-                    (&allow-other-keys (,check-state '(&key))
-                                       ,@(cadr (assoc '&allow-other-keys clauses)))
-                    (&aux (when (and (eq ,state '&rest)
-                                     (not ,restp))
-                            (error "Omitted &REST variable in ~S." ,ll))
-                          ,@(cadr (assoc '&aux clauses)))
-                    (t (error "Unsupported lambda list keyword ~S in ~S."
-                              it ,ll)))
-                  (setq ,state it))
-                 (t (case ,state
-                      (&required ,@(cddr (assoc '&required clauses)))
-                      (&optional ,@(cddr (assoc '&optional clauses)))
-                      (&rest (when ,restp
-                               (error "Too many variables after &REST in ~S." ,ll))
-                             (setq ,restp t)
-                             ,@(cddr (assoc '&rest clauses)))
-                      (&key ,@(cddr (assoc '&key clauses)))
-                      (&allow-other-keys (error "Variable ~S after &ALLOW-OTHER-KEY in ~S."
-                                                it ,ll))
-                      (&aux ,@(cddr (assoc '&aux clauses))))))))
-       (when (and (eq ,state '&rest)
-                  (not ,restp))
-         (error "Omitted &REST variable in ~S." ,ll)))))
-
 (/show "finished with pcl/macros.lisp")