X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fcompiler-support.lisp;h=5cc7d3fdb0f7531df37b4e52b741e57dde4daab4;hb=4d8b3b1da4d960a6ff768c9e6ee8f99bf270b631;hp=f4759431798f2436de38199871deb4655ba35429;hpb=3a5eefac8a65dfd36729031f0a9b9dd8c022b7f2;p=sbcl.git diff --git a/src/pcl/compiler-support.lisp b/src/pcl/compiler-support.lisp index f475943..5cc7d3f 100644 --- a/src/pcl/compiler-support.lisp +++ b/src/pcl/compiler-support.lisp @@ -39,14 +39,19 @@ (deftransform sb-pcl::pcl-instance-p ((object)) (let* ((otype (lvar-type object)) - (std-obj (specifier-type 'sb-pcl::std-object))) + (standard-object (specifier-type 'standard-object))) (cond ;; Flush tests whose result is known at compile time. - ((csubtypep otype std-obj) t) - ((not (types-equal-or-intersect otype std-obj)) nil) + ((csubtypep otype standard-object) t) + ((not (types-equal-or-intersect otype standard-object)) nil) (t `(typep (layout-of object) 'sb-pcl::wrapper))))) +(defun sb-pcl::safe-code-p (&optional env) + (let* ((lexenv (or env (make-null-lexenv))) + (policy (lexenv-policy lexenv))) + (eql (cdr (assoc 'safety policy)) 3))) + (define-source-context defmethod (name &rest stuff) (let ((arg-pos (position-if #'listp stuff))) (if arg-pos @@ -64,13 +69,6 @@ (define-function-name-syntax ,name ,@body) (pushnew ',name sb-pcl::*internal-pcl-generalized-fun-name-symbols*))) -(define-internal-pcl-function-name-syntax sb-pcl::class-predicate (list) - (when (cdr list) - (destructuring-bind (name &rest rest) (cdr list) - (when (and (symbolp name) - (null rest)) - (values t name))))) - (define-internal-pcl-function-name-syntax sb-pcl::slot-accessor (list) (when (= (length list) 4) (destructuring-bind (class slot rwb) (cdr list)