[Sbcl-commits] master: Remove unnecessary cases from PCL-INSTANCE-P

[Douglas K. <sn...@us...>]

The branch "master" has been updated in SBCL:
       via  ad41f36d99659aa960a4b80adee018cc2020d1af (commit)
      from  664facd8b94febaf876eb28de3a98b75750f098f (commit)

- Log -----------------------------------------------------------------
commit ad41f36d99659aa960a4b80adee018cc2020d1af
Author: Douglas Katzman <do...@go...>
Date:   Sat Jun 28 23:30:54 2014 -0400

    Remove unnecessary cases from PCL-INSTANCE-P
---
 src/pcl/compiler-support.lisp |    2 +-
 src/pcl/low.lisp              |   14 ++++++++++++--
 2 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/src/pcl/compiler-support.lisp b/src/pcl/compiler-support.lisp
index abc9466..650a5a3 100644
--- a/src/pcl/compiler-support.lisp
+++ b/src/pcl/compiler-support.lisp
@@ -45,7 +45,7 @@
       ((csubtypep otype standard-object) t)
       ((not (types-equal-or-intersect otype standard-object)) nil)
       (t
-       `(layout-for-std-class-p (layout-of object))))))
+       `(sb-pcl::%pcl-instance-p object)))))
 
 (defun sb-pcl::safe-code-p (&optional env)
   (let* ((lexenv (or env (make-null-lexenv)))
diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp
index 93a7ee6..c4e649a 100644
--- a/src/pcl/low.lisp
+++ b/src/pcl/low.lisp
@@ -217,9 +217,19 @@ comparison.")
 
 ;;; Return true of any object which is either a funcallable-instance,
 ;;; or an ordinary instance that is not a structure-object.
+;;; This used to be implemented as (LAYOUT-FOR-STD-CLASS-P (LAYOUT-OF x))
+;;; but LAYOUT-OF is more general than need be here. So this bails out
+;;; after the first two clauses of the equivalent COND in LAYOUT-OF
+;;; because nothing else could possibly return T.
+(declaim (inline %pcl-instance-p))
+(defun %pcl-instance-p (x)
+  (layout-for-std-class-p
+   (cond ((%instancep x) (%instance-layout x))
+         ((funcallable-instance-p x) (%funcallable-instance-layout x))
+         (t (return-from %pcl-instance-p nil)))))
+
 ;;; This definition is for interpreted code.
-(defun pcl-instance-p (x)
-  (layout-for-std-class-p (layout-of x)))
+(defun pcl-instance-p (x) (%pcl-instance-p x))
 
 ;;; CMU CL comment:
 ;;;   We define this as STANDARD-INSTANCE, since we're going to

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL