From: Christophe R. <cr...@us...> - 2006-03-08 18:50:05
|
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 |