X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdefs.lisp;h=6882bf3fcaf168b57bfafdb6873fcfb2ac02647e;hb=a736ac10b709b2d40305f0a6e3764afd246a8ef5;hp=a39b78d50f364126150a8095e8db5f867c814936;hpb=2d3cb6dba6461e98744eca2a1df4f770cea468ca;p=sbcl.git diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp index a39b78d..6882bf3 100644 --- a/src/pcl/defs.lisp +++ b/src/pcl/defs.lisp @@ -149,9 +149,9 @@ (class-eq (class-eq-specializer (coerce-to-class (car args)))) (eql (intern-eql-specializer (car args)))))) ;; FIXME: do we still need this? - ((and (null args) (typep type 'sb-kernel:classoid)) - (or (sb-kernel:classoid-pcl-class type) - (find-structure-class (sb-kernel:classoid-name type)))) + ((and (null args) (typep type 'classoid)) + (or (classoid-pcl-class type) + (find-structure-class (classoid-name type)))) ((specializerp type) type))) ;;; interface @@ -217,7 +217,7 @@ ((not and or) `(,(car type) ,@(mapcar #'convert-to-system-type (cdr type)))) ((class class-eq) ; class-eq is impossible to do right - (sb-kernel:layout-classoid (class-wrapper (cadr type)))) + (layout-classoid (class-wrapper (cadr type)))) (eql type) (t (if (null (cdr type)) (car type) @@ -358,17 +358,17 @@ (/show "about to set up SB-PCL::*BUILT-IN-CLASSES*") (defvar *built-in-classes* (labels ((direct-supers (class) - (/noshow "entering DIRECT-SUPERS" (sb-kernel::class-name class)) - (if (typep class 'sb-kernel:built-in-classoid) - (sb-kernel:built-in-classoid-direct-superclasses class) - (let ((inherits (sb-kernel:layout-inherits - (sb-kernel:classoid-layout class)))) + (/noshow "entering DIRECT-SUPERS" (classoid-name class)) + (if (typep class 'built-in-classoid) + (built-in-classoid-direct-superclasses class) + (let ((inherits (layout-inherits + (classoid-layout class)))) (/noshow inherits) (list (svref inherits (1- (length inherits))))))) (direct-subs (class) - (/noshow "entering DIRECT-SUBS" (sb-kernel::class-name class)) + (/noshow "entering DIRECT-SUBS" (classoid-name class)) (collect ((res)) - (let ((subs (sb-kernel:classoid-subclasses class))) + (let ((subs (classoid-subclasses class))) (/noshow subs) (when subs (dohash (sub v subs) @@ -403,26 +403,26 @@ (mapcar (lambda (kernel-bic-entry) (/noshow "setting up" kernel-bic-entry) (let* ((name (car kernel-bic-entry)) - (class (sb-kernel:find-classoid name))) + (class (find-classoid name))) (/noshow name class) `(,name - ,(mapcar #'sb-kernel:classoid-name (direct-supers class)) - ,(mapcar #'sb-kernel:classoid-name (direct-subs class)) + ,(mapcar #'classoid-name (direct-supers class)) + ,(mapcar #'classoid-name (direct-subs class)) ,(map 'list (lambda (x) - (sb-kernel:classoid-name - (sb-kernel:layout-classoid x))) + (classoid-name + (layout-classoid x))) (reverse - (sb-kernel:layout-inherits - (sb-kernel:classoid-layout class)))) + (layout-inherits + (classoid-layout class)))) ,(prototype name)))) (remove-if (lambda (kernel-bic-entry) (member (first kernel-bic-entry) ;; I'm not sure why these are removed from ;; the list, but that's what the original ;; CMU CL code did. -- WHN 20000715 - '(t sb-kernel:instance - sb-kernel:funcallable-instance + '(t instance + funcallable-instance function stream))) sb-kernel::*built-in-classes*)))) (/noshow "done setting up SB-PCL::*BUILT-IN-CLASSES*") @@ -432,22 +432,22 @@ (defclass t () () (:metaclass built-in-class)) -(defclass sb-kernel:instance (t) () +(defclass instance (t) () (:metaclass built-in-class)) (defclass function (t) () (:metaclass built-in-class)) -(defclass sb-kernel:funcallable-instance (function) () +(defclass funcallable-instance (function) () (:metaclass built-in-class)) -(defclass stream (sb-kernel:instance) () +(defclass stream (instance) () (:metaclass built-in-class)) (defclass slot-object (t) () (:metaclass slot-class)) -(defclass structure-object (slot-object sb-kernel:instance) () +(defclass structure-object (slot-object instance) () (:metaclass structure-class)) (defstruct (dead-beef-structure-object @@ -457,10 +457,9 @@ (defclass std-object (slot-object) () (:metaclass std-class)) -(defclass standard-object (std-object sb-kernel:instance) ()) +(defclass standard-object (std-object instance) ()) -(defclass funcallable-standard-object (std-object - sb-kernel:funcallable-instance) +(defclass funcallable-standard-object (std-object funcallable-instance) () (:metaclass funcallable-standard-class))