From: Christophe Rhodes Date: Mon, 16 Sep 2002 15:17:03 +0000 (+0000) Subject: 0.7.7.28: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e62a03c99097db9454d66f32b5edbd6af874a539;p=sbcl.git 0.7.7.28: Merge APD "bug 198" patch (sbcl-devel 2002-09-16) ... which also removes an obsolete FUN-INFO slot Fix bug 195 ... write test for atomicity of atomic defined-by-ANSI types (some of which are currently commented out) --- diff --git a/BUGS b/BUGS index fd8770f..afe5c22 100644 --- a/BUGS +++ b/BUGS @@ -1341,40 +1341,6 @@ WORKAROUND: works as it should. Perhaps this is another case of VALUES type intersections behaving in non-useful ways? -195: "confusing reporting of not-a-REAL TYPE-ERRORs from THE REAL" - In sbcl-0.7.7.10, (THE REAL #(1 2 3)) signals a type error which - prints as "This is not a (OR SINGLE-FLOAT DOUBLE-FLOAT RATIONAL)". - The (OR SINGLE-FLOAT DOUBLE-FLOAT RATIONAL) representation of - REAL is unnecessarily confusing, especially since it relies on - internal implementation knowledge that even with SHORT-FLOAT - and LONG-FLOAT left out of the union, this type is equal to REAL. - So it'd be better just to say "This is not a REAL". - -197: "failed AVER on compiling or evaluating function constants" - (reported by Antonio Martinez sbcl-devel 2002-09-12) - When compiling or evaluating function constants, such as in - (EVAL `(LAMBDA () (FUNCALL ,(LAMBDA () NIL)))) - I get the following error message: - debugger invoked on condition of type SB-INT:BUG: - failed AVER: "(LEAF-HAS-SOURCE-NAME-P LEAF)" - - Although this seems a dubious use of function constants, it would be - good either to make it work or to produce a useful error message. - -198: "conflicting THEs are not necessarily all checked" - (reported by APD sbcl-devel 2002-09-14) - (DEFUN FOO (X) - (LET (Y) - (SETF Y (THE SINGLE-FLOAT (THE INTEGER X))) - (LIST Y Y))) - - (FOO 3) => error "3 is not of type SINGLE-FLOAT" - (FOO 3F0) => (3F0 3F0) - - APD also reports that this code has not worked as intended in SBCL - since the days of sbcl-0.7.0, while CMUCL correctly detects the type - error ("is not of type NIL") for all inputs. - 199: "hairy FUNCTION types confuse the compiler" (reported by APD sbcl-devel 2002-09-15) (DEFUN MUR (F) @@ -1390,6 +1356,12 @@ WORKAROUND: APD further reports that this bug is not present in CMUCL. +200: "TRANSLATE-LOGICAL-PATHNAME fails on physical pathname namestrings" + Reported by Kevin Rosenburg on #lisp IRC 2002-09-16 + (TRANSLATE-LOGICAL-PATHNAME "/") + should simply return #P"/", but signals an error in sbcl-0.7.7.28 + + DEFUNCT CATEGORIES OF BUGS IR1-#: These labels were used for bugs related to the old IR1 interpreter. diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index f8c6561..dd483f4 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -2173,13 +2173,15 @@ (!define-type-class union) -;;; The LIST type has a special name. Other union types just get -;;; mechanically unparsed. +;;; The LIST, FLOAT and REAL types have special names. Other union +;;; types just get mechanically unparsed. (!define-type-method (union :unparse) (type) (declare (type ctype type)) - (if (type= type (specifier-type 'list)) - 'list - `(or ,@(mapcar #'type-specifier (union-type-types type))))) + (cond + ((type= type (specifier-type 'list)) 'list) + ((type= type (specifier-type 'float)) 'float) + ((type= type (specifier-type 'real)) 'real) + (t `(or ,@(mapcar #'type-specifier (union-type-types type)))))) ;;; Two union types are equal if they are each subtypes of each ;;; other. We need to be this clever because our complex subtypep diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index cb8e3a3..a3a4e1e 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -724,8 +724,7 @@ (old-type (or (lexenv-find cont type-restrictions) *wild-type*)) (intersects (values-types-equal-or-intersect old-type ctype)) - (int (values-type-intersection old-type ctype)) - (new (if intersects int old-type))) + (new (values-type-intersection old-type ctype))) (when (null (find-uses cont)) (setf (continuation-asserted-type cont) new)) (when (and (not intersects) @@ -734,8 +733,7 @@ (not (policy *lexenv* (= inhibit-warnings 3)))) ;FIXME: really OK to suppress? (compiler-warn - "The type ~S ~A conflicts with an ~ - enclosing assertion:~% ~S" + "The type ~S ~A conflicts with an enclosing assertion:~% ~S" (type-specifier ctype) place (type-specifier old-type))) diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index f3f510c..2814fda 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -102,10 +102,7 @@ (templates nil :type list) ;; If non-null, then this function is a unary type predicate for ;; this type. - (predicate-type nil :type (or ctype null)) - ;; If non-null, use this function to annotate the known call for the - ;; byte compiler. If it returns NIL, then change the call to :full. - (byte-annotate nil :type (or function null))) + (predicate-type nil :type (or ctype null))) (defprinter (fun-info) (transforms :test transforms) @@ -114,8 +111,7 @@ (ltn-annotate :test ltn-annotate) (ir2-convert :test ir2-convert) (templates :test templates) - (predicate-type :test predicate-type) - (byte-annotate :test byte-annotate)) + (predicate-type :test predicate-type)) ;;;; interfaces to defining macros diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index e8572ce..db25462 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -348,6 +348,17 @@ BUG 48c, not yet fixed: (assert (null v)) (assert (typep e 'type-error))) (assert (equal (exercise-0-7-7-24-bug -4) '(3f0 3f0))) + +;;; non-intersecting type declarations were DWIMing in a confusing +;;; fashion until sbcl-0.7.7.28, when APD reported and fixed the +;;; problem. +(defun non-intersecting-the (x) + (let (y) + (setf y (the single-float (the integer x))) + (list y y))) + +(raises-error? (foo 3) type-error) +(raises-error? (foo 3f0) type-error) ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp index 12af699..9222e6a 100644 --- a/tests/type.pure.lisp +++ b/tests/type.pure.lisp @@ -26,3 +26,128 @@ (nil (or number vector) nil) (12 (or null vector) nil) (12 (and (or number vector) real) t)))) + + +;;; This test is motivated by bug #195, which previously had (THE REAL +;;; #(1 2 3)) give an error which prints as "This is not a (OR +;;; SINGLE-FLOAT DOUBLE-FLOAT RATIONAL)". We ideally want all of the +;;; defined-by-ANSI types to unparse as themselves or at least +;;; something similar (e.g. CHARACTER can unparse to BASE-CHAR, since +;;; the types are equivalent in current SBCL). +(let ((standard-types '(;; from table 4-2 in section 4.2.3 in the + ;; CLHS. + arithmetic-error + function + simple-condition + array + generic-function + simple-error + ;; (NOT CONS) + ;; atom + hash-table + simple-string + base-char + integer + simple-type-error + base-string + keyword + simple-vector + bignum + list + simple-warning + bit + logical-pathname + single-float + bit-vector + long-float + ;; MEMBER-TYPE #\a #\b ... + ;; standard-char + broadcast-stream + method + standard-class + built-in-class + method-combination + standard-generic-function + cell-error + nil + standard-method + character + null + standard-object + class + number + storage-condition + compiled-function + package + stream + complex + package-error + stream-error + concatenated-stream + parse-error + string + condition + pathname + ;; OR STRING-INPUT-STREAM STRING-OUTPUT-STREAM + ;; FILL-POINTER-OUTPUT-STREAM + ;; string-stream + cons + print-not-readable + structure-class + control-error + program-error + structure-object + division-by-zero + random-state + style-warning + double-float + ratio + symbol + echo-stream + rational + synonym-stream + end-of-file + reader-error + t + error + readtable + two-way-stream + ;; This one's hard: (AND BASE-CHAR (NOT BASE-CHAR)) + ;; + ;; This is because it looks like + ;; (AND CHARACTER (NOT BASE-CHAR)) + ;; but CHARACTER is equivalent to + ;; BASE-CHAR. So if we fix intersection of + ;; obviously disjoint types and then do (the + ;; extended-char foo), we'll get back FOO is + ;; not a NIL. -- CSR, 2002-09-16. + ;; extended-char + real + type-error + file-error + restart + unbound-slot + file-stream + ;; (OR CONS NULL VECTOR) + ;; sequence + unbound-variable + fixnum + serious-condition + undefined-function + float + short-float + unsigned-byte + floating-point-inexact + signed-byte + vector + floating-point-invalid-operation + simple-array + warning + floating-point-overflow + simple-base-string + floating-point-underflow + simple-bit-vector))) + (dolist (type standard-types) + (format t "~&~S~%" type) + (assert (not (sb-kernel:unknown-type-p (sb-kernel:specifier-type type)))) + (assert (atom (sb-kernel:type-specifier (sb-kernel:specifier-type type)))))) diff --git a/version.lisp-expr b/version.lisp-expr index 2cfa302..328dd71 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; internal versions off the main CVS branch, it gets hairier, e.g. ;;; "0.pre7.14.flaky4.13".) -"0.7.7.27" +"0.7.7.28"