1.0.48.9: better source information for compile-time type errors

  Compile-time warning: in addition to the context, also tell exactly
  which form produces the value that is not of the expected type.

  Run-time error: include both the error context and exact form in the
  error message.

  Delete VALUES-TYPE-ERROR, and use SIMPLE-TYPE-ERROR for both legs in
  %COMPILE-TIME-TYPE-ERROR.

diff --git a/NEWS b/NEWS
index bb86954..48085ff 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,8 @@ changes relative to sbcl-1.0.48:
     are more readable.
   * enhancement: RUN-PROGRAM works with user-defined binary input and output
     streams.
+  * enhancement: more informative compile-time warnings and runtime
+    errors for type-errors detected at compile-time.
   * bug fix: blocking reads from FIFOs created by RUN-PROGRAM were
     uninterruptible, as well as blocking reads from socket streams created
     with for which :SERVE-EVENTS NIL. (regression from 1.0.42.43)

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 58090b2..f46895d 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1688,7 +1688,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "UPDATE-OBJECT-LAYOUT-OR-INVALID"
                "VALUE-CELL-REF" "VALUE-CELL-SET" "VALUES-SPECIFIER-TYPE"
                "VALUES-SPECIFIER-TYPE-CACHE-CLEAR" "VALUES-SUBTYPEP"
-               "VALUES-TYPE" "VALUES-TYPE-ERROR" "VALUES-TYPE-IN"
+               "VALUES-TYPE" "VALUES-TYPE-IN"
                "VALUES-TYPE-INTERSECTION"
                "VALUES-TYPE-MIN-VALUE-COUNT" "VALUES-TYPE-MAX-VALUE-COUNT"
                "VALUES-TYPE-MAY-BE-SINGLE-VALUE-P" "VALUES-TYPE-OPTIONAL"

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index acaf32b..a952750 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -1088,15 +1088,6 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL."))
 (define-condition encapsulated-condition (condition)
   ((condition :initarg :condition :reader encapsulated-condition)))
 
-(define-condition values-type-error (type-error)
-  ()
-  (:report
-   (lambda (condition stream)
-     (format stream
-             "~@<The values set ~2I~:_[~{~S~^ ~}] ~I~_is not of type ~2I~_~S.~:>"
-             (type-error-datum condition)
-             (type-error-expected-type condition)))))
-
 ;;; KLUDGE: a condition for floating point errors when we can't or
 ;;; won't figure out what type they are. (In FreeBSD and OpenBSD we
 ;;; don't know how, at least as of sbcl-0.6.7; in Linux we probably

diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp
index dc9cffd..124b488 100644 (file)
--- a/src/compiler/ctype.lisp
+++ b/src/compiler/ctype.lisp
@@ -892,26 +892,49 @@
                            (lvar-source tag)
                            (type-specifier (lvar-type tag))))))
 
-(defun %compile-time-type-error (values atype dtype)
+(defun %compile-time-type-error (values atype dtype context)
   (declare (ignore dtype))
-  (if (and (consp atype)
-           (eq (car atype) 'values))
-      (error 'values-type-error :datum values :expected-type atype)
-      (error 'type-error :datum (car values) :expected-type atype)))
+  (destructuring-bind (form . detail) context
+    (if (and (consp atype) (eq (car atype) 'values))
+        (error 'simple-type-error
+               :datum (car values)
+               :expected-type atype
+               :format-control
+               "~@<Value set ~2I~_[~{~S~^ ~}] ~I~_from ~S in ~2I~_~S ~I~_is ~
+                   not of type ~2I~_~S.~:>"
+               :format-arguments (list values
+                                       detail form
+                                       atype))
+        (error 'simple-type-error
+               :datum (car values)
+               :expected-type atype
+               :format-control "~@<Value of ~S in ~2I~_~S ~I~_is ~2I~_~S, ~
+                                ~I~_not a ~2I~_~S.~:@>"
+               :format-arguments (list detail form
+                                       (car values)
+                                       atype)))))
 
 (defoptimizer (%compile-time-type-error ir2-convert)
-    ((objects atype dtype) node block)
+    ((objects atype dtype context) node block)
   (let ((*compiler-error-context* node))
     (setf (node-source-path node)
           (cdr (node-source-path node)))
-    (destructuring-bind (values atype dtype)
+    (destructuring-bind (values atype dtype context)
         (basic-combination-args node)
       (declare (ignore values))
       (let ((atype (lvar-value atype))
-            (dtype (lvar-value dtype)))
-      (unless (eq atype nil)
-        (warn 'type-warning
-              :format-control
-              "~@<Asserted type ~S conflicts with derived type ~S.~@:>"
-              :format-arguments (list atype dtype)))))
+            (dtype (lvar-value dtype))
+            (detail (cdr (lvar-value context))))
+        (unless (eq atype nil)
+          (if (constantp detail)
+              (warn 'type-warning
+                 :format-control
+                 "~@<Constant ~2I~_~S ~Iconflicts with its asserted type ~
+                     ~2I~_~S.~@:>"
+                 :format-arguments (list (eval detail) atype))
+              (warn 'type-warning
+                 :format-control
+                 "~@<Derived type of ~S is ~2I~_~S, ~I~_conflicting with ~
+                     its asserted type ~2I~_~S.~@:>"
+                 :format-arguments (list detail dtype atype))))))
     (ir2-convert-full-call node block)))

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index f86bff6..9f1085f 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1434,7 +1434,7 @@
 
 ;; FIXME: This function does not return, but due to the implementation
 ;; of FILTER-LVAR we cannot write it here.
-(defknown %compile-time-type-error (t t t) *)
+(defknown %compile-time-type-error (t t t t) *)
 (defknown sb!kernel::case-failure (t t t) nil)
 
 (defknown %odd-key-args-error () nil)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 3c5d7a3..59b6bfd 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -2098,17 +2098,20 @@
         (unless (eq value-type *empty-type*)
 
           ;; FIXME: Do it in one step.
-          (filter-lvar
-           value
-           (if (cast-single-value-p cast)
-               `(list 'dummy)
-               `(multiple-value-call #'list 'dummy)))
-          (filter-lvar
-           (cast-value cast)
-           ;; FIXME: Derived type.
-           `(%compile-time-type-error 'dummy
-                                      ',(type-specifier atype)
-                                      ',(type-specifier value-type)))
+          (let ((context (cons (node-source-form cast)
+                               (lvar-source (cast-value cast)))))
+            (filter-lvar
+             value
+             (if (cast-single-value-p cast)
+                 `(list 'dummy)
+                 `(multiple-value-call #'list 'dummy)))
+            (filter-lvar
+             (cast-value cast)
+             ;; FIXME: Derived type.
+             `(%compile-time-type-error 'dummy
+                                        ',(type-specifier atype)
+                                        ',(type-specifier value-type)
+                                        ',context)))
           ;; KLUDGE: FILTER-LVAR does not work for non-returning
           ;; functions, so we declare the return type of
           ;; %COMPILE-TIME-TYPE-ERROR to be * and derive the real type

diff --git a/version.lisp-expr b/version.lisp-expr
index 08d7c69..2072a3d 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.48.8"
+"1.0.48.9"