X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-type.lisp;h=ddf35edcfbb567b723ca0965af6a2114f97061e7;hb=cd13034f9415f64cdaa05893a4ac5ff1e95c97bd;hp=bae3258de5880a65a3ab6c1d8dd649319b26bf36;hpb=58ff25d134554f86b15d1978ae21861ccbe70f3d;p=sbcl.git diff --git a/src/code/target-type.lisp b/src/code/target-type.lisp index bae3258..ddf35ed 100644 --- a/src/code/target-type.lisp +++ b/src/code/target-type.lisp @@ -33,15 +33,15 @@ named-type member-type array-type - sb!xc:built-in-class + built-in-classoid cons-type) (values (%typep obj type) t)) - (sb!xc:class + (classoid (if (if (csubtypep type (specifier-type 'funcallable-instance)) (funcallable-instance-p obj) (typep obj 'instance)) - (if (eq (class-layout type) - (info :type :compiler-layout (sb!xc:class-name type))) + (if (eq (classoid-layout type) + (info :type :compiler-layout (classoid-name type))) (values (sb!xc:typep obj type) t) (values nil nil)) (values nil t))) @@ -129,16 +129,16 @@ ;; KLUDGE: In order to really make this run at run time ;; (instead of doing some weird broken thing at cold load ;; time), we need to suppress a DEFTRANSFORM.. -- WHN 19991004 - (declare (notinline sb!xc:find-class)) - (class-layout (sb!xc:find-class 'null)))) + (declare (notinline find-classoid)) + (classoid-layout (find-classoid 'null)))) (t (svref *built-in-class-codes* (widetag-of x))))) -#!-sb-fluid (declaim (inline sb!xc:class-of)) -(defun sb!xc:class-of (object) +#!-sb-fluid (declaim (inline classoid-of)) +(defun classoid-of (object) #!+sb-doc "Return the class of the supplied object, which may be any Lisp object, not just a CLOS STANDARD-OBJECT." - (layout-class (layout-of object))) + (layout-classoid (layout-of object))) ;;; Pull the type specifier out of a function object. (defun extract-fun-type (fun) @@ -148,7 +148,10 @@ ;;; Clear memoization of all type system operations that can be ;;; altered by type definition/redefinition. +;;; +;;; FIXME: This should be autogenerated. (defun clear-type-caches () + (declare (special *type-system-initialized*)) (when *type-system-initialized* (dolist (sym '(values-specifier-type-cache-clear values-type-union-cache-clear @@ -156,7 +159,8 @@ values-subtypep-cache-clear csubtypep-cache-clear type-intersection2-cache-clear - values-type-intersection-cache-clear)) + values-type-intersection-cache-clear + type=-cache-clear)) (funcall (the function (symbol-function sym))))) (values)) @@ -173,7 +177,7 @@ (typecase x (function (if (funcallable-instance-p x) - (sb!xc:class-of x) + (classoid-of x) (extract-fun-type x))) (symbol (make-member-type :members (list x))) @@ -188,7 +192,7 @@ (cons (make-cons-type *universal-type* *universal-type*)) (t - (sb!xc:class-of x)))) + (classoid-of x)))) ;;; Clear this cache on GC so that we don't hold onto too much garbage. (pushnew 'ctype-of-cache-clear *before-gc-hooks*)