From: Christophe Rhodes <crhodes@us...>  20060914 21:10:52

Update of /cvsroot/sbcl/sbcl/src/compiler/generic In directory sc8prcvs8.sourceforge.net:/tmp/cvsserv4113/src/compiler/generic Modified Files: primtype.lisp Log Message: 0.9.16.30: A couple of typesystem fixups for #+sbeval ... we have to have sbeval:interpretedfunction defined on the host, so that the deftype for COMPILEDFUNCTION does not involve any unknown types. So ... make !defstructwithalternatemetaclass compilable by the host compiler, similarly to sbxc:defstruct. Don't quite do it properly: put a FIXME note in for posterity. ... move earlyfulleval.lisp earlier in the build, and split out the definition for compiledfunction from deftypesfortarget to latedeftypesfortarget (after the interpretedfunction class is defined) ... (declare (type compiledfunction x)) should do a type check for compiledfunction, not for simply FUNCTION. ... the problem was actually in PRIMITIVETYPE on intersection types; the computation was fairly bogus. Make it less bogus. ... also delete some stale classoid symbols. Index: primtype.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/primtype.lisp,v retrieving revision 1.23 retrieving revision 1.24 diff u d r1.23 r1.24  primtype.lisp 8 Mar 2006 18:49:57 0000 1.23 +++ primtype.lisp 14 Sep 2006 21:10:44 0000 1.24 @@ 313,19 +313,33 @@ (return (any))))))))))) (intersectiontype (let ((types (intersectiontypetypes type))  (res (any))  (exact nil))  (dolist (type types (values res exact))  (multiplevaluebind (ptype ptypeexact) + (res (any))) + ;; why NIL for the exact? Well, we assume that the + ;; intersection type is in fact doing something for us: + ;; that is, that each of the types in the intersection is + ;; in fact cutting off some of the type lattice. Since no + ;; intersection type is represented by a primitive type and + ;; primitive types are mutually exclusive, it follows that + ;; no intersection type can represent the entirety of the + ;; primitive type. (And NIL is the conservative answer, + ;; anyway).  CSR, 20060914 + (dolist (type types (values res nil)) + (multiplevaluebind (ptype) (primitivetype type)  (when ptypeexact  (aver (or (not exact) (eq ptype res)))  (setq exact t))  (when (or ptypeexact (and (not exact) (eq res (any))))  ;; Try to find a narrower representation then  ;; (any). Takes care of undecidable types in  ;; intersections with decidable ones.  (setq res ptype)))))) + (cond + ;; if the result so far is (any), any improvement on + ;; the specificity of the primitive type is valid. + ((eq res (any)) + (setq res ptype)) + ;; if the primitive type returned is (any), the + ;; result so far is valid. Likewise, if the + ;; primitive type is the same as the result so far, + ;; everything is fine. + ((or (eq ptype (any)) (eq ptype res))) + ;; otherwise, we have something hairy and confusing, + ;; such as (and condition funcallableinstance). + ;; Punt. + (t (return (any)))))))) (membertype (let* ((members (membertypemembers type)) (res (primitivetypeof (first members)))) 