0.7.13.pcl-class.2

[sbcl.git] / src / pcl / braid.lisp

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index 2570376..25bc778 100644 (file)
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -67,7 +67,7 @@
                                             (get-instance-hash-code))))
     (set-funcallable-instance-fun
      fin
-     #'(sb-kernel:instance-lambda (&rest args)
+     #'(instance-lambda (&rest args)
         (declare (ignore args))
         (error "The function of the funcallable-instance ~S has not been set."
                fin)))
@@ -493,11 +493,11 @@
     (dolist (e *built-in-classes*)
       (destructuring-bind (name supers subs cpl prototype) e
        (let* ((class (find-class name))
-              (lclass (sb-kernel:find-classoid name))
-              (wrapper (sb-kernel:classoid-layout lclass)))
+              (lclass (find-classoid name))
+              (wrapper (classoid-layout lclass)))
          (set (get-built-in-class-symbol name) class)
          (set (get-built-in-wrapper-symbol name) wrapper)
-         (setf (sb-kernel:classoid-pcl-class lclass) class)
+         (setf (classoid-pcl-class lclass) class)
 
          (!bootstrap-initialize-class 'built-in-class class
                                       name class-eq-wrapper nil
@@ -512,7 +512,7 @@
            (make-class-predicate class (class-predicate-name class))))))
 \f
 (defmacro wrapper-of-macro (x)
-  `(sb-kernel:layout-of ,x))
+  `(layout-of ,x))
 
 (defun class-of (x)
   (wrapper-class* (wrapper-of-macro x)))
@@ -544,9 +544,9 @@
                        :metaclass 'structure-class
                        :name symbol
                        :direct-superclasses
-                        (mapcar #'sb-kernel:classoid-name
-                                (sb-kernel:classoid-direct-superclasses
-                                 (sb-kernel:find-classoid symbol)))
+                        (mapcar #'classoid-name
+                                (classoid-direct-superclasses
+                                 (find-classoid symbol)))
                        :direct-slots
                        (mapcar #'slot-initargs-from-structure-slotd
                                (structure-type-slot-description-list
@@ -589,36 +589,36 @@
 ;;; Set the inherits from CPL, and register the layout. This actually
 ;;; installs the class in the Lisp type system.
 (defun update-lisp-class-layout (class layout)
-  (let ((lclass (sb-kernel:layout-classoid layout)))
-    (unless (eq (sb-kernel:classoid-layout lclass) layout)
-      (setf (sb-kernel:layout-inherits layout)
-              (sb-kernel:order-layout-inherits
+  (let ((lclass (layout-classoid layout)))
+    (unless (eq (classoid-layout lclass) layout)
+      (setf (layout-inherits layout)
+              (order-layout-inherits
                (map 'simple-vector #'class-wrapper
                     (reverse (rest (class-precedence-list class))))))
-      (sb-kernel:register-layout layout :invalidate t)
+      (register-layout layout :invalidate t)
 
       ;; Subclasses of formerly forward-referenced-class may be
       ;; unknown to CL:FIND-CLASS and also anonymous. This
       ;; functionality moved here from (SETF FIND-CLASS).
       (let ((name (class-name class)))
-       (setf (sb-kernel:find-classoid name) lclass
-             (sb-kernel:classoid-name lclass) name)))))
+       (setf (find-classoid name) lclass
+             (classoid-name lclass) name)))))
 
 (defun set-class-type-translation (class name)
-  (let ((classoid (sb-kernel:find-classoid name nil)))
+  (let ((classoid (find-classoid name nil)))
     (etypecase classoid
       (null)
-      (sb-kernel:built-in-classoid
-       (let ((translation (sb-kernel::built-in-classoid-translation classoid)))
+      (built-in-classoid
+       (let ((translation (built-in-classoid-translation classoid)))
         (cond
           (translation
-           (aver (sb-kernel:ctype-p translation))
+           (aver (ctype-p translation))
            (setf (info :type :translator class)
                  (lambda (spec) (declare (ignore spec)) translation)))
           (t
            (setf (info :type :translator class)
                  (lambda (spec) (declare (ignore spec)) classoid))))))
-      (sb-kernel:classoid
+      (classoid
        (setf (info :type :translator class)
             (lambda (spec) (declare (ignore spec)) classoid))))))
 
@@ -633,19 +633,19 @@
 (dohash (name x *find-class*)
        (let* ((class (find-class-from-cell name x))
               (layout (class-wrapper class))
-              (lclass (sb-kernel:layout-classoid layout))
-              (lclass-pcl-class (sb-kernel:classoid-pcl-class lclass))
-              (olclass (sb-kernel:find-classoid name nil)))
+              (lclass (layout-classoid layout))
+              (lclass-pcl-class (classoid-pcl-class lclass))
+              (olclass (find-classoid name nil)))
          (if lclass-pcl-class
              (aver (eq class lclass-pcl-class))
-             (setf (sb-kernel:classoid-pcl-class lclass) class))
+             (setf (classoid-pcl-class lclass) class))
 
          (update-lisp-class-layout class layout)
 
          (cond (olclass
                 (aver (eq lclass olclass)))
                (t
-                (setf (sb-kernel:find-classoid name) lclass)))
+                (setf (find-classoid name) lclass)))
 
          (set-class-type-translation class name)))