[Sbcl-commits] CVS: sbcl/src/code class.lisp,1.65,1.66 condition.lisp,1.74,1.75 late-type.lisp,1.125,1.126

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28697/src/code

Modified Files:
	class.lisp condition.lisp late-type.lisp 
Log Message:
0.9.10.24:
	Fix (I think) the %INSTANCE-REF build problems on PPC and 
	probably SPARC.
	... the CTYPE-OF failure came about because the system didn't
		know that (AND INSTANCE FUNCTION) was NIL.  Make it
		so...
	... and then delete a stale KLUDGE workaround in primtype.lisp
	... this then built as far as stream.lisp, where the problem
		was that (AND INSTANCE STREAM) was being "simplified"
		to just STREAM, and then primtype didn't know that
		STREAMs are subtypes of INSTANCE...
	... which in fact they're not; CLOS allows us to construct
		funcallable streams.  So...
	... instead teach the system that (AND INSTANCE STREAM) 
		shouldn't be simplified...
	... but (AND INSTANCE FD-STREAM) should.
	... (also delete some crufty classoids: BASIC-STRUCTURE-CLASS
		and FUNCALLABLE-STRUCTURE-CLASS were never used)
	... tests for all the failing things in type.{before,after}-xc 


Index: class.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/class.lisp,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -d -r1.65 -r1.66
--- class.lisp	2 Dec 2005 14:30:13 -0000	1.65
+++ class.lisp	8 Mar 2006 18:49:55 -0000	1.66
@@ -677,29 +677,13 @@
   ;; during cold-load.
   (translation nil :type (or ctype (member nil :initializing))))
 
-;;; FIXME: In CMU CL, this was a class with a print function, but not
-;;; necessarily a structure class (e.g. CONDITIONs). In SBCL,
-;;; we let CLOS handle our print functions, so that is no longer needed.
-;;; Is there any need for this class any more?
-(def!struct (slot-classoid (:include classoid)
-                           (:constructor nil)))
-
 ;;; STRUCTURE-CLASS represents what we need to know about structure
 ;;; classes. Non-structure "typed" defstructs are a special case, and
 ;;; don't have a corresponding class.
-(def!struct (basic-structure-classoid (:include slot-classoid)
-                                      (:constructor nil)))
-
-(def!struct (structure-classoid (:include basic-structure-classoid)
+(def!struct (structure-classoid (:include classoid)
                                 (:constructor make-structure-classoid))
   ;; If true, a default keyword constructor for this structure.
   (constructor nil :type (or function null)))
-
-;;; FUNCALLABLE-STRUCTURE-CLASS is used to represent funcallable
-;;; structures, which are used to implement generic functions.
-(def!struct (funcallable-structure-classoid
-             (:include basic-structure-classoid)
-             (:constructor make-funcallable-structure-classoid)))
 
 ;;;; classoid namespace
 
@@ -870,8 +854,8 @@
         ;; Otherwise, we can't in general be sure that the
         ;; intersection is empty, since a subclass of both might be
         ;; defined. But we can eliminate it for some special cases.
-        ((or (basic-structure-classoid-p class1)
-             (basic-structure-classoid-p class2))
+        ((or (structure-classoid-p class1)
+             (structure-classoid-p class2))
          ;; No subclass of both can be defined.
          *empty-type*)
         ((eq (classoid-state class1) :sealed)

Index: condition.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/condition.lisp,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -d -r1.74 -r1.75
--- condition.lisp	27 Feb 2006 13:12:34 -0000	1.74
+++ condition.lisp	8 Mar 2006 18:49:55 -0000	1.75
@@ -41,7 +41,7 @@
 
 (/show0 "condition.lisp 24")
 
-(def!struct (condition-classoid (:include slot-classoid)
+(def!struct (condition-classoid (:include classoid)
                                 (:constructor make-condition-classoid))
   ;; list of CONDITION-SLOT structures for the direct slots of this
   ;; class

Index: late-type.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/late-type.lisp,v
retrieving revision 1.125
retrieving revision 1.126
diff -u -d -r1.125 -r1.126
--- late-type.lisp	14 Feb 2006 17:15:00 -0000	1.125
+++ late-type.lisp	8 Mar 2006 18:49:55 -0000	1.126
@@ -1167,7 +1167,7 @@
                   (values nil t))
                  ((eq type1 (find-classoid 'function))
                   (values nil t))
-                 ((or (basic-structure-classoid-p type1)
+                 ((or (structure-classoid-p type1)
                       #+nil
                       (condition-classoid-p type1))
                   (values t t))
@@ -1196,9 +1196,15 @@
      (if (classoid-p type1)
          (if (and (not (member type1 *non-instance-classoid-types*
                                :key #'find-classoid))
+                  (not (eq type1 (find-classoid 'function)))
                   (not (find (classoid-layout (find-classoid 'function))
                              (layout-inherits (classoid-layout type1)))))
-             type1
+             (if (or (structure-classoid-p type1)
+                     (and (not (eq type1 (find-classoid 'stream)))
+                          (not (find (classoid-layout (find-classoid 'stream))
+                                     (layout-inherits (classoid-layout type1))))))
+                 type1
+                 nil)
              *empty-type*)
          (if (type-might-contain-other-types-p type1)
              nil
@@ -1211,7 +1217,7 @@
                         (layout-inherits (classoid-layout type1))))
              type1
              (if (type= type1 (find-classoid 'function))
-                 type1
+                 type2
                  nil))
          (if (fun-type-p type1)
              nil