Index: /branches/working-0711/ccl/level-1/l1-clos.lisp
===================================================================
--- /branches/working-0711/ccl/level-1/l1-clos.lisp	(revision 7945)
+++ /branches/working-0711/ccl/level-1/l1-clos.lisp	(revision 7946)
@@ -599,10 +599,12 @@
 	    (class-finalized-p class)
 	    (not (class-has-a-forward-referenced-superclass-p class)))
-    (update-cpl class (compute-class-precedence-list  class))
-    ;;; This -should- be made to work for structure classes
-    (update-slots class (compute-slots class))
-    (setf (%class-default-initargs class) (compute-default-initargs class))
-    (%flush-initargs-caches class)
-    )
+    (let* ((cpl (update-cpl class (compute-class-precedence-list  class))))
+      ;; This -should- be made to work for structure classes
+      (update-slots class (compute-slots class))
+      (setf (%class-default-initargs class) (compute-default-initargs class))
+      (%flush-initargs-caches class)
+      (let* ((wrapper (%class-own-wrapper class)))
+        (when wrapper
+          (setf (%wrapper-cpl wrapper) cpl)))))
   (unless finalizep
     (dolist (sub (%class-direct-subclasses class))
@@ -1103,6 +1105,6 @@
 		 (:name slot-id :initform nil :initfunction ,#'false
                   :readers (slot-definition-slot-id))
-		 (:name type-predicate :initform #'true
-		  :initfunction ,#'(lambda () #'true)
+		 (:name type-predicate :initform nil
+		  :initfunction ,#'false
 		  :readers (slot-definition-predicate))
 		 )
@@ -1192,7 +1194,8 @@
             (add-direct-subclass c class)))
         (setf (%class.local-supers class) new-supers)))
-    (unless (%class-own-wrapper class)
-      (setf (%class-own-wrapper class) (%cons-wrapper class)))
-    (update-cpl class (compute-cpl class))))
+    (let* ((wrapper (or (%class-own-wrapper class)
+                        (setf (%class-own-wrapper class) (%cons-wrapper class))))
+           (cpl (compute-cpl class)))
+      (setf (%wrapper-cpl wrapper) cpl))))
               
 
@@ -1716,5 +1719,6 @@
                  ;; Typecheck the new-value, then call
                  ;; (SETF SLOT-VALUE-USING-CLASS)
-                 (unless (funcall predicate new-value)
+                 (unless (or (null predicate)
+                             (funcall predicate new-value))
                    (error 'bad-slot-type-from-initarg
                           :slot-definition slotd
@@ -1736,5 +1740,6 @@
                    (if initfunction
                      (let* ((newval (funcall initfunction)))
-                       (unless (funcall predicate newval)
+                       (unless (or (null predicate)
+                                   (funcall predicate newval))
                          (error 'bad-slot-type-from-initform
                                 :slot-definition slotd
@@ -2034,4 +2039,6 @@
 
 
+
+
 ;;; Return a lambda form or NIL.
 (defun make-instantiate-lambda-for-class-cell (cell)
@@ -2061,14 +2068,9 @@
                    (if (null *typecheck-slots-in-optimized-make-instance*)
                      form
-                     (let* ((ctype (ignore-errors (specifier-type type))))
-                       (if (or (null ctype)
-                               (eq ctype *universal-type*)
-                               (typep ctype 'unknown-ctype))
-                         form
-                         (if spvar
-                           `(if ,spvar
-                             (require-type ,form ',type)
-                             (%slot-unbound-marker))
-                           `(require-type ,form ',type)))))))
+                     (if spvar
+                       `(if ,spvar
+                         (require-type ,form ',type)
+                         (%slot-unbound-marker))
+                       `(require-type ,form ',type)))))
             (dolist (slot slotds)
               (let* ((initarg (car (slot-definition-initargs slot)))