From 43f10df63cb39285e85df7ac85a0dbd065adcb2d Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Mon, 8 Feb 1993 22:12:19 +0000
Subject: [PATCH] Update structure type hackery

---
 compiler/typetran.lisp | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

diff --git a/compiler/typetran.lisp b/compiler/typetran.lisp
index 2e8cd9d6a..11e4ce5e1 100644
--- a/compiler/typetran.lisp
+++ b/compiler/typetran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.14.1.2 1993/01/23 14:34:43 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.14.1.3 1993/02/08 22:12:19 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -137,7 +137,7 @@
   (define-type-predicate simple-string-p simple-string)
   (define-type-predicate simple-vector-p simple-vector)
   (define-type-predicate stringp string)
-  (define-type-predicate instancep instance)
+  (define-type-predicate %instancep instance)
   (define-type-predicate symbolp symbol)
   (define-type-predicate vectorp vector))
 
@@ -343,9 +343,8 @@
 ;;; named, error.  If a structure, call S-T-STRUCTURE-TYPEP.  Otherwise, call
 ;;; CLASS-TYPEP at run-time with the layout and class object.
 ;;;
-(defun source-transform-instance-typep (obj desc)
-  (let* ((class (instance-type-class desc))
-	 (name (class-name class))
+(defun source-transform-instance-typep (obj class)
+  (let* ((name (class-name class))
 	 (layout (info type compiler-layout name)))
     (cond
      ((not (and name (eq (find-class name) class)))
@@ -359,7 +358,7 @@
      (t
       (multiple-value-bind
 	  (pred layout)
-	  (if (funcallable-class-p class)
+	  (if (csubtypep class (specifier-type 'generic-function))
 	      (values 'funcallable-instance-p 'funcallable-instance-layout)
 	      (values '%instancep '%instance-layout))
 	(once-only ((object obj))
@@ -426,7 +425,7 @@
 	       (source-transform-union-typep object type))
 	      (member-type
 	       `(member ,object ',(member-type-members type)))
-	      (instance-type
+	      (class
 	       (source-transform-instance-typep object type))
 	      (args-type
 	       (compiler-warning "Illegal type specifier for Typep: ~S."
-- 
GitLab