diff --git a/pcl/braid.lisp b/pcl/braid.lisp index 1aea28cc0804e237759afd218fc80ea6ba00dfa4..9ac6f8750ddb96a8960359eaeb28fdd224c7afbf 100644 --- a/pcl/braid.lisp +++ b/pcl/braid.lisp @@ -712,13 +712,19 @@ ;;; class in the lisp type system. ;;; (defun update-lisp-class-layout (class layout) - (unless (eq (kernel:class-layout (kernel:layout-class layout)) - layout) - (setf (kernel:layout-inherits layout) - (map 'vector #'class-wrapper - (reverse (rest (class-precedence-list class))))) - - (kernel:register-layout layout :invalidate nil))) + (let ((lclass (kernel:layout-class layout))) + (unless (eq (kernel:class-layout lclass) layout) + (setf (kernel:layout-inherits layout) + (map 'vector #'class-wrapper + (reverse (rest (class-precedence-list class))))) + (kernel:register-layout layout :invalidate nil) + + ;; Subclasses of formerly forward-referenced-class may be unknown + ;; to lisp:find-class and also anonymous. This functionality moved + ;; here from (setf find-class). + (let ((name (class-name class))) + (setf (lisp:find-class name) lclass + (lisp:class-name lclass) name))))) (eval-when (load eval) (clrhash *find-class*) diff --git a/pcl/macros.lisp b/pcl/macros.lisp index b8be040cef8cfd6be04411fe5ab16c58ea41b0e4..c3faa4e1666d89a322e64675ba03b8193c4c7064 100644 --- a/pcl/macros.lisp +++ b/pcl/macros.lisp @@ -501,20 +501,16 @@ (setf (find-class-cell-class cell) new-value) (when (or (eq *boot-state* 'complete) (eq *boot-state* 'braid)) - #+cmu17 - (let ((lclass (kernel:layout-class (class-wrapper new-value)))) - (setf (lisp:class-name lclass) (class-name new-value)) - (unless (eq (lisp:find-class symbol nil) lclass) - (setf (lisp:find-class symbol) lclass))) - - (setf (find-class-cell-predicate cell) - (symbol-function (class-predicate-name new-value))) + (when (and new-value (class-wrapper new-value)) + (setf (find-class-cell-predicate cell) + (symbol-function (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))))) + 'make-instance-function)))) + new-value) (error "~S is not a legal class name." symbol))) #-setf diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp index 4949963e1fbc644f1dd15f2087aca8ed04ca3d60..c0aff0de493978d107e00c2e4b414d3773b10a1e 100644 --- a/pcl/std-class.lisp +++ b/pcl/std-class.lisp @@ -324,7 +324,11 @@ :definition-source `((defclass ,name) ,(load-truename)) other))) - #+cmu17 (kernel:layout-class (class-wrapper res)) + ;; Defclass of a class with a forward-referenced superclass does not + ;; have a wrapper. RES is the incomplete PCL class. The Lisp class + ;; does not yet exist. Maybe should return NIL in that case as RES + ;; is not useful to the user? + #+cmu17 (and (class-wrapper res)(kernel:layout-class (class-wrapper res))) #-cmu17 res)) (setf (gdefinition 'load-defclass) #'real-load-defclass)