~ chicken-core (chicken-5) 9c0c03e02c83f2a868e96bd19607c51c0f1ee0f0

commit 9c0c03e02c83f2a868e96bd19607c51c0f1ee0f0
Author:     megane <meganeka@gmail.com>
AuthorDate: Mon Nov 19 11:18:51 2018 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sat Mar 9 20:28:18 2019 +1300

    Print types in scrutinizer messages with pretty-print
    
    Using `pp' to print types starts to shine when you're getting bigger
    list, vector or procedure types.
    
    Also, try to always print a relevant code fragment. This helps to find
    the actual code the warning is originating from, or help debug the issue
    when the actual code is just a macro call.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 988f56cc..c4bb70b5 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -154,12 +154,6 @@
 (define-inline (value-type? t)
   (or (struct-type? t) (memq t value-types)))
 
-(define (type-name x)
-  (let ((t (strip-syntax x)))
-    (if (refinement-type? t)
-	(sprintf "~a-~a" (string-intersperse (map conc (second t)) "/") (third t))
-	(sprintf "~a" t))))
-
 (define specialization-statistics '())
 (define trail '())
 
@@ -180,13 +174,13 @@
     (when *complain?*
       (##sys#notice
        (conc (location-name loc)
-	     (sprintf "~?" msg (map type-name args))))))
+	     (sprintf "~?" msg args)))))
 
   (define (report loc msg . args)
     (when *complain?*
       (warning
        (conc (location-name loc)
-	     (sprintf "~?" msg (map type-name args))))))
+	     (sprintf "~?" msg args)))))
 
   (set! *complain?* complain)
 
@@ -278,12 +272,12 @@
 
     (define (always-true if-node test-node t loc)
       (and-let* ((_ (always-true1 t)))
-	(r-cond-test-always-true loc test-node t if-node)
+	(r-cond-test-always-true loc if-node test-node t)
 	#t))
 
     (define (always-false if-node test-node t loc)
       (and-let* ((_ (eq? t 'false)))
-	(r-cond-test-always-false loc test-node if-node)
+	(r-cond-test-always-false loc if-node test-node)
 	#t))
 
     (define (always-immediate var t loc)
@@ -319,9 +313,7 @@
 
     (define (call-result node args e loc params typeenv)
       (define (pname)
-	(sprintf "~ain procedure call to `~s', "
-		 (node-source-prefix node)
-		 (fragment (first (node-subexpressions node)))))
+	(fragment (first (node-subexpressions node))))
       (let* ((actualtypes (map walked-result args))
 	     (ptype (car actualtypes))
 	     (pptype? (procedure-type? ptype))
@@ -332,13 +324,13 @@
 	(d "  call: ~a, te: ~a" actualtypes typeenv)
 	(cond ((and (not pptype?) (not (match-types xptype ptype typeenv)))
 	       (r-invalid-called-procedure-type
-		loc (pname) (resolve xptype typeenv) (resolve ptype typeenv))
+		loc node (resolve xptype typeenv) (resolve ptype typeenv))
 	       (values '* #f))
 	      (else
 	       (let-values (((atypes values-rest ok alen)
 			     (procedure-argument-types ptype nargs typeenv)))
 		 (unless ok
-		   (r-proc-call-argument-count-mismatch loc (pname) alen nargs))
+		   (r-proc-call-argument-count-mismatch loc node (pname) alen nargs ptype))
 		 (do ((actualtypes (cdr actualtypes) (cdr actualtypes))
 		      (atypes atypes (cdr atypes))
 		      (i 1 (add1 i)))
@@ -348,9 +340,10 @@
 			    (car actualtypes)
 			    typeenv)
 		     (r-proc-call-argument-type-mismatch
-		      loc (pname) i
+		      loc node (pname) i
 		      (resolve (car atypes) typeenv)
-		      (resolve (car actualtypes) typeenv))))
+		      (resolve (car actualtypes) typeenv)
+		      ptype)))
 		 (when (noreturn-procedure-type? ptype)
 		   (set! noreturn #t))
 		 (let ((r (procedure-result-types ptype values-rest (cdr actualtypes) typeenv)))
@@ -361,7 +354,8 @@
 				   (variable-mark pn '##compiler#predicate)) =>
 				   (lambda (pt)
 				     (cond ((match-argument-types (list pt) (cdr actualtypes) typeenv)
-					    (r-pred-call-always-true loc (pname) (cadr actualtypes))
+					    (r-pred-call-always-true
+					     loc node (pname) pt (cadr actualtypes))
 					    (when specialize
 					      (specialize-node!
 					       node (cdr args)
@@ -371,7 +365,8 @@
 					   ((begin
 					      (trail-restore trail0 typeenv)
 					      (match-argument-types (list `(not ,pt)) (cdr actualtypes) typeenv))
-					    (r-pred-call-always-false loc (pname) (cadr actualtypes))
+					    (r-pred-call-always-false
+					     loc node (pname) pt (cadr actualtypes))
 					    (when specialize
 					      (specialize-node!
 					       node (cdr args)
@@ -502,7 +497,7 @@
 				   ;;(dd " branches: ~s:~s / ~s:~s" nor1 r1 nor2 r2)
 				   (cond ((and (not nor1) (not nor2)
 					       (not (= (length r1) (length r2))))
-					  (r-cond-branch-value-count-mismatch loc n)
+					  (r-cond-branch-value-count-mismatch loc n c a r1 r2)
 					  '*)
 					 (nor1 r2)
 					 (nor2 r1)
@@ -602,7 +597,7 @@
                                              (eq? (car type) 'deprecated))))
 			       (not (match-types type rt typeenv)))
 		      (when strict (set! errors #t))
-		      (r-toplevel-var-assignment-type-mismatch loc rt var type))
+		      (r-toplevel-var-assignment-type-mismatch loc n rt var type (first subs)))
 		    (when (and (not type) ;XXX global declaration could allow this
 			       (not b)
 			       (not (eq? '* rt))
@@ -765,14 +760,14 @@
 		  (let ((t (first params))
 			(rt (walk (first subs) e loc dest tail flow ctags)))
 		    (cond ((eq? rt '*))
-			  ((null? rt) (r-zero-values-for-the loc t))
+			  ((null? rt) (r-zero-values-for-the loc (first subs) t))
 			  (else
 			   (when (> (length rt) 1)
-			     (r-too-many-values-for-the loc rt))
+			     (r-too-many-values-for-the loc (first subs) t rt))
 			   (when (and (second params)
 				      (not (compatible-types? t (first rt))))
 			     (when strict (set! errors #t))
-			     (r-type-mismatch-in-the loc (first rt) t))))
+			     (r-type-mismatch-in-the loc (first subs) (first rt) t))))
 		    (list t)))
 		 ((##core#typecase)
 		  (let* ((ts (walk (first subs) e loc #f #f flow ctags))
@@ -1646,17 +1641,20 @@
 	   (let-values (((t pred pure) (validate-type new name)))
 	     (unless t
 	       (warning
-		(sprintf "invalid type specification for `~a': ~a"
+		(sprintf "Invalid type specification for `~a':~%~%~a"
 			 name
-			 (type-name new))))
+			 (type->pp-string new))))
 	     (when (and old (not (compatible-types? old t)))
 	       (warning
 		(sprintf
-		 "type definition for toplevel binding `~a' \
-		  conflicts with previously loaded type:\
-		  ~n  New type:      ~a\
-		  ~n  Original type: ~a"
-		 name (type-name old) (type-name new))))
+		 (string-append
+		  "Declared type for toplevel binding `~a'"
+		  "~%~%~a~%~%"
+		  "  conflicts with previously loaded type:"
+		  "~%~%~a")
+		 name
+		 (type->pp-string new)
+		 (type->pp-string old))))
 	     (mark-variable name '##compiler#type t)
 	     (mark-variable name '##compiler#type-source 'db)
 	     (when specs
@@ -2080,7 +2078,7 @@
   (define (report loc msg . args)
     (warning
      (conc (location-name loc)
-	   (sprintf "~?" msg (map type-name args)))))
+	   (sprintf "~?" msg args))))
 
   (define (known-length-vector-index node args loc expected-argcount)
     (and-let* ((subs (node-subexpressions node))
@@ -2145,7 +2143,7 @@
   (define (report loc msg . args)
     (warning
      (conc (location-name loc)
-	   (sprintf "~?" msg (map type-name args)))))
+	   (sprintf "~?" msg args))))
 
   (define (list-or-null a)
     (if (null? a) 'null `(list ,@a)))
@@ -2257,7 +2255,7 @@
   (define (report loc msg . args)
     (warning
      (conc (location-name loc)
-	   (sprintf "~?" msg (map type-name args)))))
+	   (sprintf "~?" msg args))))
 
   (define (append-special-case node args loc rtypes)
     (define (potentially-proper-list? l) (match-types l 'list '()))
@@ -2291,12 +2289,16 @@
 		(unless (or (null? (cdr arg-types))
 			    (potentially-proper-list? arg1))
 		  (report
-		   loc "~ain procedure call to `~a', argument #~a is \
-			of type ~a but expected a proper list"
+		   loc
+		   (string-append
+		    "~ain procedure call to `~a', argument #~a is of type"
+		    "~%~%~a~%~%"
+		    "  but expected a proper list.")
 		   (node-source-prefix node)
 		   (first (node-parameters
 			   (first (node-subexpressions node))))
-		   index arg1))
+		   index
+		   (type->pp-string arg1)))
 		#f))))))
     (cond ((derive-result-type) => list)
 	  (else rtypes)))
@@ -2401,6 +2403,30 @@
 (define (multiples n)
   (if (= n 1) "" "s"))
 
+(define (string-add-indent str #!optional (indent "  "))
+  (let* ((ls (string-split str "\n" #t))
+	 (s (string-intersperse
+	     (map (lambda (l)
+		    (if (string=? "" l)
+			l
+			(string-append indent l)))
+		  ls)
+	     "\n")))
+    (if (eq? #\newline (string-ref str (sub1 (string-length str))))
+	(string-append s "\n")
+	s)))
+
+(define (type->pp-string t)
+  (string-add-indent
+   (string-chomp
+    (with-output-to-string
+      (lambda ()
+	(let ((t (strip-syntax t)))
+	  (if (refinement-type? t)
+	      (printf "~a-~a" (string-intersperse (map conc (second t)) "/") (third t))
+	      (pp t))))))
+   "  "))
+
 (define (fragment x)
   (let ((x (build-expression-tree (source-node-tree x))))
     (let walk ((x x) (d 0))
@@ -2415,128 +2441,330 @@
 	    (else (strip-syntax x))))))
 
 (define (pp-fragment x)
-  (string-chomp
-   (with-output-to-string
-     (lambda ()
-       (pp (fragment x))))))
+  (string-add-indent
+   (string-chomp
+    (with-output-to-string
+      (lambda ()
+	(pp (fragment x)))))
+   "  "))
 
 (define (node-source-prefix n)
   (let ((line (node-line-number n)))
     (if (not line) "" (sprintf "(~a) " line))))
 
-(define (location-name loc)
+(define (location-name loc #!optional (indent "  "))
   (define (lname loc1)
     (if loc1
-	(sprintf "procedure `~a'" (real-name loc1))
-	"unknown procedure"))
-  (cond ((null? loc) "at toplevel:\n  ")
-	((null? (cdr loc))
-	 (sprintf "in toplevel ~a:\n  " (lname (car loc))))
-	(else
-	 (let rec ((loc loc))
-	   (if (null? (cdr loc))
-	       (location-name loc)
-	       (sprintf "in local ~a,\n  ~a" (lname (car loc)) (rec (cdr loc))))))))
-
-(define (report2 loc msg . args)
+	(real-name loc1)
+	"(unknown procedure)"))
+  (if (null? loc)
+      (sprintf "At toplevel\n~a" indent)
+      (let rec ((loc loc)
+		(msgs (list "")))
+	(if (null? (cdr loc))
+	    (string-intersperse
+	     (cons (sprintf "In `~a', a toplevel procedure" (lname (car loc))) msgs)
+	     (sprintf "\n~a" indent))
+	    (rec (cdr loc)
+		 (cons (sprintf "In `~a', a local procedure" (lname (car loc))) msgs))))))
+
+(define (report2 report-f location-node-candidates loc msg . args)
+  (define (file-location)
+    (any (lambda (n) (and (not (string=? "" (node-source-prefix n)))
+		     (node-source-prefix n)))
+	 location-node-candidates))
   (when *complain?*
-    (warning
-     (conc (location-name loc)
-	   (sprintf "~?" msg (map type-name args))))))
+    (report-f
+     (conc
+      "Type mismatch"
+      (let ((l (file-location))) (if l (conc " " l) ""))
+      (string-add-indent
+       (conc "\n" (location-name loc "") (sprintf "~?" msg args))
+       "  ")))))
 
-(define (report-notice2 loc msg . args)
-  (when *complain?*
-    (##sys#notice
-     (conc (location-name loc)
-	   (sprintf "~?" msg (map type-name args))))))
+(define (report-notice2 location-node-candidates loc msg . args)
+  (apply report2 ##sys#notice location-node-candidates loc msg args))
 
 ;;; Reports
 
-(define (r-invalid-called-procedure-type loc pname xptype ptype)
+(define (r-invalid-called-procedure-type loc node xptype ptype)
   (report2
+   warning
+   (list node)
    loc
-   "~aexpected a value of type `~a' but was given a value of type `~a'"
-   pname xptype ptype))
-
-(define (r-proc-call-argument-count-mismatch loc pname exp-count argc)
+   (string-append
+    "In procedure call"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Procedure in a procedure call has invalid type"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "The expected type is"
+    "~%~%"
+    "~a")
+   (pp-fragment node)
+   (type->pp-string ptype)
+   (type->pp-string xptype)))
+
+(define (r-proc-call-argument-count-mismatch loc node pname exp-count argc ptype)
   (report2
+   warning
+   (list node)
    loc
-   "~aexpected ~a argument~a but was given ~a argument~a"
+   (string-append
+    "In procedure call"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Procedure `~a' is called with ~a argument~a but ~a argument~a is expected."
+    "~%~%"
+    "The procedure's type is"
+    "~%~%"
+    "~a")
+   (pp-fragment node)
    pname
+   argc (multiples argc)
    exp-count (multiples exp-count)
-   argc (multiples argc)))
+   (type->pp-string ptype)))
 
-(define (r-proc-call-argument-type-mismatch loc pname i xptype atype)
+(define (r-proc-call-argument-type-mismatch loc node pname i xptype atype ptype)
   (report2
+   warning
+   (list node)
    loc
-   "~aexpected argument #~a of type `~a' but was given an argument of type `~a'"
-   pname i xptype atype))
+   (string-append
+    "In procedure call"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Argument #~a to procedure `~a' has invalid type"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "The expected type is"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "The procedure's type is"
+    "~%~%"
+    "~a")
+   (pp-fragment node)
+   i
+   pname
+   (type->pp-string atype)
+   (type->pp-string xptype)
+   (type->pp-string ptype)))
 
-(define (r-pred-call-always-true loc pname atype)
+(define (r-pred-call-always-true loc node pname pred-type atype)
+  ;; pname is "... proc call to predicate `foo' "
   (report-notice2
+   (list node)
    loc
-   "~athe predicate is called with an argument of type `~a' \
-					      and will always return true"
-   pname atype))
+   (string-append
+    "In predicate call"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Predicate call will always return true."
+    "~%~%"
+    "Procedure `~a' is a predicate for"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "The given argument has type"
+    "~%~%"
+    "~a")
+   (pp-fragment node)
+   pname
+   (type->pp-string pred-type)
+   (type->pp-string atype)))
 
-(define (r-pred-call-always-false loc pname atype)
+(define (r-pred-call-always-false loc node pname pred-type atype)
   (report-notice2
+   (list node)
    loc
-   "~athe predicate is called with an argument of type `~a' \
-					      and will always return false"
-   pname atype))
+   (string-append
+    "In predicate call"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Predicate call will always return false."
+    "~%~%"
+    "Procedure `~a' is a predicate for"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "The given argument has type"
+    "~%~%"
+    "~a")
+   (pp-fragment node)
+   pname
+   (type->pp-string pred-type)
+   (type->pp-string atype)))
 
-(define (r-cond-test-always-true loc test-node t if-node)
+(define (r-cond-test-always-true loc if-node test-node t)
   (report-notice2
-   loc "~aexpected a value of type boolean in conditional, but \
-	 was given a value of type `~a' which is always true:~%~%~a"
-   (node-source-prefix test-node) t (pp-fragment if-node)))
-
-(define (r-cond-test-always-false loc test-node if-node)
+   (list test-node if-node)
+   loc
+   (string-append
+    "In conditional expression"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Test condition has always true value of type"
+    "~%~%"
+    "~a")
+   (pp-fragment if-node)
+   (type->pp-string t)))
+
+(define (r-cond-test-always-false loc if-node test-node)
   (report-notice2
-   loc "~ain conditional, test expression will always return false:~%~%~a"
-   (node-source-prefix test-node) (pp-fragment if-node)))
-
-(define (r-zero-values-for-the loc the-type)
+   (list test-node if-node)
+   loc
+   (string-append
+    "In conditional expression"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Test condition is always false.")
+   (pp-fragment if-node)))
+
+(define (r-zero-values-for-the loc node the-type)
   ;; (the t r) expects r returns exactly 1 value
   (report2
+   warning
+   (list node)
    loc
-   "expression returns zero values but is declared to have \
-			     a single result of type `~a'"
-   the-type))
-
-(define (r-too-many-values-for-the loc rtypes)
+   (string-append
+    "In expression"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Expression returns 0 values but is declared to return"
+    "~%~%"
+    "~a")
+   (pp-fragment node)
+   (type->pp-string the-type)))
+
+(define (r-too-many-values-for-the loc node the-type rtypes)
   (report2
+   warning
+   (list node)
    loc
-   "expression returns ~a values but is declared to have \
-			       a single result" (length rtypes)))
-
-(define (r-type-mismatch-in-the loc first-rtype the-type)
+   (string-append
+    "In expression"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Expression returns too many values."
+    "~%~%"
+    "The expression returns ~a values but is declared to return"
+    "~%~%"
+    "~a")
+   (pp-fragment node)
+   (length rtypes)
+   (type->pp-string the-type)))
+
+(define (r-type-mismatch-in-the loc node first-rtype the-type)
   (report2
+   warning
+   (list node)
    loc
-   "expression returns a result of type `~a' but is \
-			       declared to return `~a', which is not compatible"
-   first-rtype the-type))
+   (string-append
+    "In expression"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Expression's declared and actual types do not match."
+    "~%~%"
+    "The actual type is"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "The expression's declared type is"
+    "~%~%"
+    "~a")
+   (pp-fragment node)
+   (type->pp-string first-rtype)
+   (type->pp-string the-type)))
 
 (define (fail-compiler-typecase loc node atype ct-types)
+  (define (pp-type t) (string-add-indent (type->pp-string t) "  "))
   (quit-compiling
-   "~a~ano clause applies in `compiler-typecase' for expression of type `~a':~a"
+   (string-append
+    "Type mismatch"
+    "~a"
+    "~a"
+    "In `compiler-typecase' expression"
+    "~%~%"
+    "  ~a"
+    "~%~%"
+    "  Tested expression in `compiler-typecase' does not match any case."
+    "~%~%"
+    "  The expression has this type"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "  The specified type cases are these"
+    "~%~%"
+    "~a")
+   (if (string=? "" (node-source-prefix node))
+       "\n"
+       (conc " " (node-source-prefix node) "\n  "))
    (location-name loc)
-   (node-source-prefix node)
-   (type-name atype)
-   (string-intersperse (map (lambda (t) (sprintf "\n    ~a" (type-name t))) ct-types)
-		       "")))
+   (pp-fragment node)
+   (pp-type atype)
+   (string-intersperse (map pp-type ct-types) "\n\n")))
 
-(define (r-cond-branch-value-count-mismatch loc node)
+(define (r-cond-branch-value-count-mismatch loc node c-node a-node c-types a-types)
   (report2
+   warning
+   (list a-node node)
    loc
-   "branches in conditional expression differ in the number of results:~%~%~a"
-   (pp-fragment node)))
-
-(define (r-toplevel-var-assignment-type-mismatch loc atype var xptype)
+   (string-append
+    "In conditional expression"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "The branches have different number of returned values."
+    "~%~%"
+    "The true branch returns ~a value~a"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "The false branch returns ~a value~a"
+    "~%~%"
+    "~a")
+   (pp-fragment node)
+   (length c-types) (multiples (length c-types))
+   (pp-fragment c-node)
+   (length a-types) (multiples (length a-types))
+   (pp-fragment a-node)))
+
+(define (r-toplevel-var-assignment-type-mismatch loc node atype var xptype value-node)
   (report2
+   warning
+   (list node value-node)
    loc
-   "assignment of value of type `~a' to toplevel variable `~a' \
-			does not match declared type `~a'"
-   atype var xptype))
+   (string-append
+    "In assignment"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Variable `~a' is assigned invalid value."
+    "~%~%"
+    "The assigned value has type"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "The declared type of `~a' is"
+    "~%~%"
+    "~a")
+   (pp-fragment node)
+   var
+   (type->pp-string atype)
+   var
+   (type->pp-string xptype)))
 )
diff --git a/tests/scrutinizer-message-format.expected b/tests/scrutinizer-message-format.expected
index 1855a5fc..986c2b16 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -5,236 +5,542 @@ Warning: literal in operator position: (1 2)
 
 Warning: literal in operator position: (1 2)
 
-Warning: in toplevel procedure `r-proc-call-argument-count-mismatch':
-  (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#cons', expected 2 arguments but was given 1 argument
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `r-proc-call-argument-count-mismatch', a toplevel procedure
+  In procedure call
 
-Warning: in toplevel procedure `r-proc-call-argument-type-mismatch':
-  (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#length', expected argument #1 of type `list' but was given an argument of type `symbol'
+    (scheme#cons '())
 
-Warning: in toplevel procedure `r-proc-call-argument-value-count':
+  Procedure `scheme#cons' is called with 1 argument but 2 arguments is expected.
+
+  The procedure's type is
+
+    (forall (aXXX bXXX) (procedure scheme#cons (aXXX bXXX) (pair aXXX bXXX)))
+
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `r-proc-call-argument-type-mismatch', a toplevel procedure
+  In procedure call
+
+    (scheme#length 'symbol)
+
+  Argument #1 to procedure `scheme#length' has invalid type
+
+    symbol
+
+  The expected type is
+
+    list
+
+  The procedure's type is
+
+    (procedure scheme#length (list) fixnum)
+
+Warning: In `r-proc-call-argument-value-count', a toplevel procedure
   (test-scrutinizer-message-format.scm:XXX) expected a single result in argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but received 2 results
 
-Warning: in toplevel procedure `r-proc-call-argument-value-count':
+Warning: In `r-proc-call-argument-value-count', a toplevel procedure
   (test-scrutinizer-message-format.scm:XXX) expected a single result in argument #1 of procedure call `(scheme#vector (scheme#values))', but received zero results
 
-Warning: in toplevel procedure `r-proc-call-argument-value-count':
+Warning: In `r-proc-call-argument-value-count', a toplevel procedure
   expected a single result in `let' binding of `gXXX', but received zero results
 
-Warning: in toplevel procedure `r-cond-branch-value-count-mismatch':
-  branches in conditional expression differ in the number of results:
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `r-cond-branch-value-count-mismatch', a toplevel procedure
+  In conditional expression
+
+    (if (the * 1) 1 (scheme#values 1 2))
+
+  The branches have different number of returned values.
+
+  The true branch returns 1 value
+
+    1
 
-(if (the * 1) 1 (scheme#values 1 2))
+  The false branch returns 2 values
 
-Warning: in toplevel procedure `r-invalid-called-procedure-type':
-  in procedure call to `1', expected a value of type `(procedure (*) *)' but was given a value of type `fixnum'
+    (scheme#values 1 2)
 
-Note: in toplevel procedure `r-pred-call-always-true':
-  (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#list?', the predicate is called with an argument of type `null' and will always return true
+Warning: Type mismatch
+  In `r-invalid-called-procedure-type', a toplevel procedure
+  In procedure call
 
-Note: in toplevel procedure `r-pred-call-always-false':
-  (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `fixnum' and will always return false
+    (1 2)
 
-Note: in toplevel procedure `r-cond-test-always-true':
-  expected a value of type boolean in conditional, but was given a value of type `symbol' which is always true:
+  Procedure in a procedure call has invalid type
 
-(if 'symbol 1 (##core#undefined))
+    fixnum
 
-Note: in toplevel procedure `r-cond-test-always-false':
-  in conditional, test expression will always return false:
+  The expected type is
 
-(if #f 1 (##core#undefined))
+    (procedure (*) *)
 
-Warning: in toplevel procedure `r-type-mismatch-in-the':
-  expression returns a result of type `fixnum' but is declared to return `symbol', which is not compatible
+Note: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `r-pred-call-always-true', a toplevel procedure
+  In predicate call
+
+    (scheme#list? '())
+
+  Predicate call will always return true.
+
+  Procedure `scheme#list?' is a predicate for
+
+    list
 
-Warning: in toplevel procedure `r-zero-values-for-the':
-  expression returns zero values but is declared to have a single result of type `symbol'
+  The given argument has type
 
-Warning: in toplevel procedure `r-too-many-values-for-the':
-  expression returns 2 values but is declared to have a single result
+    null
 
-Warning: in toplevel procedure `r-too-many-values-for-the':
-  expression returns a result of type `fixnum' but is declared to return `symbol', which is not compatible
+Note: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `r-pred-call-always-false', a toplevel procedure
+  In predicate call
 
-Warning: in toplevel procedure `r-toplevel-var-assignment-type-mismatch':
-  assignment of value of type `fixnum' to toplevel variable `foo' does not match declared type `boolean'
+    (scheme#symbol? 1)
 
-Warning: in toplevel procedure `r-deprecated-identifier':
+  Predicate call will always return false.
+
+  Procedure `scheme#symbol?' is a predicate for
+
+    symbol
+
+  The given argument has type
+
+    fixnum
+
+Note: Type mismatch
+  In `r-cond-test-always-true', a toplevel procedure
+  In conditional expression
+
+    (if 'symbol 1 (##core#undefined))
+
+  Test condition has always true value of type
+
+    symbol
+
+Note: Type mismatch
+  In `r-cond-test-always-false', a toplevel procedure
+  In conditional expression
+
+    (if #f 1 (##core#undefined))
+
+  Test condition is always false.
+
+Warning: Type mismatch
+  In `r-type-mismatch-in-the', a toplevel procedure
+  In expression
+
+    1
+
+  Expression's declared and actual types do not match.
+
+  The actual type is
+
+    fixnum
+
+  The expression's declared type is
+
+    symbol
+
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `r-zero-values-for-the', a toplevel procedure
+  In expression
+
+    (scheme#values)
+
+  Expression returns 0 values but is declared to return
+
+    symbol
+
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `r-too-many-values-for-the', a toplevel procedure
+  In expression
+
+    (scheme#values 1 2)
+
+  Expression returns too many values.
+
+  The expression returns 2 values but is declared to return
+
+    symbol
+
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `r-too-many-values-for-the', a toplevel procedure
+  In expression
+
+    (scheme#values 1 2)
+
+  Expression's declared and actual types do not match.
+
+  The actual type is
+
+    fixnum
+
+  The expression's declared type is
+
+    symbol
+
+Warning: Type mismatch
+  In `r-toplevel-var-assignment-type-mismatch', a toplevel procedure
+  In assignment
+
+    (set! foo 1)
+
+  Variable `foo' is assigned invalid value.
+
+  The assigned value has type
+
+    fixnum
+
+  The declared type of `foo' is
+
+    boolean
+
+Warning: In `r-deprecated-identifier', a toplevel procedure
   use of deprecated `deprecated-foo'
 
-Warning: in toplevel procedure `r-deprecated-identifier':
+Warning: In `r-deprecated-identifier', a toplevel procedure
   use of deprecated `deprecated-foo2' - consider `foo'
 
-Warning: at toplevel:
-  assignment of value of type `fixnum' to toplevel variable `foo' does not match declared type `boolean'
+Warning: Type mismatch
+  At toplevel
+  In assignment
+
+    (set! foo 1)
+
+  Variable `foo' is assigned invalid value.
+
+  The assigned value has type
+
+    fixnum
+
+  The declared type of `foo' is
 
-Warning: in toplevel procedure `list-ref-negative-index':
+    boolean
+
+Warning: In `list-ref-negative-index', a toplevel procedure
   (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#list-ref', index -1 is negative, which is never valid
 
-Warning: in toplevel procedure `list-ref-out-of-range':
+Warning: In `list-ref-out-of-range', a toplevel procedure
   (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#list-ref', index 1 out of range for proper list of length 0
 
-Warning: in toplevel procedure `vector-ref-out-of-range':
+Warning: In `vector-ref-out-of-range', a toplevel procedure
   (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#vector-ref', index -1 out of range for vector of length 0
 
-Warning: in toplevel procedure `zero-values-for-let':
+Warning: In `zero-values-for-let', a toplevel procedure
   expected a single result in `let' binding of `a', but received zero results
 
-Warning: in toplevel procedure `multiple-values-for-let':
+Warning: In `multiple-values-for-let', a toplevel procedure
   expected a single result in `let' binding of `a', but received 2 results
 
-Warning: in toplevel procedure `zero-values-for-conditional':
+Warning: In `zero-values-for-conditional', a toplevel procedure
   expected a single result in conditional, but received zero results
 
-Warning: in toplevel procedure `multiple-values-for-conditional':
+Warning: In `multiple-values-for-conditional', a toplevel procedure
   expected a single result in conditional, but received 2 results
 
-Note: in toplevel procedure `multiple-values-for-conditional':
-  (test-scrutinizer-message-format.scm:XXX) expected a value of type boolean in conditional, but was given a value of type `fixnum' which is always true:
+Note: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `multiple-values-for-conditional', a toplevel procedure
+  In conditional expression
+
+    (if (scheme#values 1 2) 1 (##core#undefined))
+
+  Test condition has always true value of type
+
+    fixnum
+
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-proc-call-argument-count-mismatch', a local procedure
+  In procedure call
+
+    (scheme#cons '())
+
+  Procedure `scheme#cons' is called with 1 argument but 2 arguments is expected.
+
+  The procedure's type is
+
+    (forall (aXXX bXXX) (procedure scheme#cons (aXXX bXXX) (pair aXXX bXXX)))
+
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-proc-call-argument-type-mismatch', a local procedure
+  In procedure call
 
-(if (scheme#values 1 2) 1 (##core#undefined))
+    (scheme#length 'symbol)
 
-Warning: in local procedure `r-proc-call-argument-count-mismatch',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#cons', expected 2 arguments but was given 1 argument
+  Argument #1 to procedure `scheme#length' has invalid type
 
-Warning: in local procedure `r-proc-call-argument-type-mismatch',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#length', expected argument #1 of type `list' but was given an argument of type `symbol'
+    symbol
+
+  The expected type is
+
+    list
+
+  The procedure's type is
+
+    (procedure scheme#length (list) fixnum)
 
-Warning: in local procedure `r-proc-call-argument-value-count',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-proc-call-argument-value-count', a local procedure
   (test-scrutinizer-message-format.scm:XXX) expected a single result in argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but received 2 results
 
-Warning: in local procedure `r-proc-call-argument-value-count',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-proc-call-argument-value-count', a local procedure
   (test-scrutinizer-message-format.scm:XXX) expected a single result in argument #1 of procedure call `(scheme#vector (scheme#values))', but received zero results
 
-Warning: in local procedure `r-proc-call-argument-value-count',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-proc-call-argument-value-count', a local procedure
   expected a single result in `let' binding of `gXXX', but received zero results
 
-Warning: in local procedure `r-cond-branch-value-count-mismatch',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  branches in conditional expression differ in the number of results:
-
-(if (the * 1) 1 (chicken.time#cpu-time))
-
-Warning: in local procedure `r-invalid-called-procedure-type',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  in procedure call to `1', expected a value of type `(procedure (*) *)' but was given a value of type `fixnum'
-
-Note: in local procedure `r-pred-call-always-true',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#list?', the predicate is called with an argument of type `null' and will always return true
-
-Note: in local procedure `r-pred-call-always-false',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `fixnum' and will always return false
-
-Note: in local procedure `r-cond-test-always-true',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  (test-scrutinizer-message-format.scm:XXX) expected a value of type boolean in conditional, but was given a value of type `fixnum' which is always true:
-
-(if (scheme#length '()) 1 (##core#undefined))
-
-Note: in local procedure `r-cond-test-always-false',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  in conditional, test expression will always return false:
-
-(if #f 1 (##core#undefined))
-
-Warning: in local procedure `r-type-mismatch-in-the',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  expression returns a result of type `fixnum' but is declared to return `symbol', which is not compatible
-
-Warning: in local procedure `r-zero-values-for-the',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  expression returns zero values but is declared to have a single result of type `symbol'
-
-Warning: in local procedure `r-too-many-values-for-the',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  expression returns 2 values but is declared to have a single result
-
-Warning: in local procedure `r-too-many-values-for-the',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  expression returns a result of type `fixnum' but is declared to return `symbol', which is not compatible
-
-Warning: in local procedure `r-toplevel-var-assignment-type-mismatch',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  assignment of value of type `fixnum' to toplevel variable `m#foo2' does not match declared type `boolean'
-
-Warning: in local procedure `r-deprecated-identifier',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-cond-branch-value-count-mismatch', a local procedure
+  In conditional expression
+
+    (if (the * 1) 1 (chicken.time#cpu-time))
+
+  The branches have different number of returned values.
+
+  The true branch returns 1 value
+
+    1
+
+  The false branch returns 2 values
+
+    (chicken.time#cpu-time)
+
+Warning: Type mismatch
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-invalid-called-procedure-type', a local procedure
+  In procedure call
+
+    (1 2)
+
+  Procedure in a procedure call has invalid type
+
+    fixnum
+
+  The expected type is
+
+    (procedure (*) *)
+
+Note: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-pred-call-always-true', a local procedure
+  In predicate call
+
+    (scheme#list? '())
+
+  Predicate call will always return true.
+
+  Procedure `scheme#list?' is a predicate for
+
+    list
+
+  The given argument has type
+
+    null
+
+Note: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-pred-call-always-false', a local procedure
+  In predicate call
+
+    (scheme#symbol? 1)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#symbol?' is a predicate for
+
+    symbol
+
+  The given argument has type
+
+    fixnum
+
+Note: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-cond-test-always-true', a local procedure
+  In conditional expression
+
+    (if (scheme#length '()) 1 (##core#undefined))
+
+  Test condition has always true value of type
+
+    fixnum
+
+Note: Type mismatch
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-cond-test-always-false', a local procedure
+  In conditional expression
+
+    (if #f 1 (##core#undefined))
+
+  Test condition is always false.
+
+Warning: Type mismatch
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-type-mismatch-in-the', a local procedure
+  In expression
+
+    1
+
+  Expression's declared and actual types do not match.
+
+  The actual type is
+
+    fixnum
+
+  The expression's declared type is
+
+    symbol
+
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-zero-values-for-the', a local procedure
+  In expression
+
+    (scheme#values)
+
+  Expression returns 0 values but is declared to return
+
+    symbol
+
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-too-many-values-for-the', a local procedure
+  In expression
+
+    (scheme#values 1 2)
+
+  Expression returns too many values.
+
+  The expression returns 2 values but is declared to return
+
+    symbol
+
+Warning: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-too-many-values-for-the', a local procedure
+  In expression
+
+    (scheme#values 1 2)
+
+  Expression's declared and actual types do not match.
+
+  The actual type is
+
+    fixnum
+
+  The expression's declared type is
+
+    symbol
+
+Warning: Type mismatch
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-toplevel-var-assignment-type-mismatch', a local procedure
+  In assignment
+
+    (set! m#foo2 1)
+
+  Variable `m#foo2' is assigned invalid value.
+
+  The assigned value has type
+
+    fixnum
+
+  The declared type of `m#foo2' is
+
+    boolean
+
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-deprecated-identifier', a local procedure
   use of deprecated `m#deprecated-foo'
 
-Warning: in local procedure `r-deprecated-identifier',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-deprecated-identifier', a local procedure
   use of deprecated `m#deprecated-foo2' - consider `foo'
 
-Warning: in local procedure `list-ref-negative-index',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `list-ref-negative-index', a local procedure
   (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#list-ref', index -1 is negative, which is never valid
 
-Warning: in local procedure `list-ref-out-of-range',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `list-ref-out-of-range', a local procedure
   (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#list-ref', index 1 out of range for proper list of length 0
 
-Warning: in local procedure `vector-ref-out-of-range',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `vector-ref-out-of-range', a local procedure
   (test-scrutinizer-message-format.scm:XXX) in procedure call to `scheme#vector-ref', index -1 out of range for vector of length 0
 
-Warning: in local procedure `zero-values-for-let',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `zero-values-for-let', a local procedure
   expected a single result in `let' binding of `a', but received zero results
 
-Warning: in local procedure `multiple-values-for-let',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `multiple-values-for-let', a local procedure
   expected a single result in `let' binding of `a', but received 2 results
 
-Warning: in local procedure `zero-values-for-conditional',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `zero-values-for-conditional', a local procedure
   expected a single result in conditional, but received zero results
 
-Warning: in local procedure `multiple-values-for-conditional',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `multiple-values-for-conditional', a local procedure
   expected a single result in conditional, but received 2 results
 
-Note: in local procedure `multiple-values-for-conditional',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  (test-scrutinizer-message-format.scm:XXX) expected a value of type boolean in conditional, but was given a value of type `fixnum' which is always true:
+Note: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `multiple-values-for-conditional', a local procedure
+  In conditional expression
+
+    (if (scheme#values 1 2) 1 (##core#undefined))
+
+  Test condition has always true value of type
+
+    fixnum
+
+Error: Type mismatch (test-scrutinizer-message-format.scm:XXX) 
+  In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `fail-compiler-typecase', a local procedure
+  In `compiler-typecase' expression
 
-(if (scheme#values 1 2) 1 (##core#undefined))
+    (compiler-typecase gXXX (symbol 1) (list 2) (else (##core#undefined)))
+
+  Tested expression in `compiler-typecase' does not match any case.
+
+  The expression has this type
+
+    fixnum
+
+  The specified type cases are these
 
-Error: in local procedure `fail-compiler-typecase',
-  in local procedure `local-bar',
-  in toplevel procedure `m#toplevel-foo':
-  (test-scrutinizer-message-format.scm:XXX) no clause applies in `compiler-typecase' for expression of type `fixnum':
     symbol
+
     list
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 79c7ad5b..58f98619 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -1,68 +1,354 @@
 ;; numbers replaced with XXX by redact-gensyms.scm
 ;; prefixes: (tmp g scm:)
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#pair?', the predicate is called with an argument of type `pair' and will always return true
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#pair?', the predicate is called with an argument of type `null' and will always return false
+    (scheme#pair? p)
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#pair?', the predicate is called with an argument of type `null' and will always return false
+  Predicate call will always return true.
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#pair?', the predicate is called with an argument of type `fixnum' and will always return false
+  Procedure `scheme#pair?' is a predicate for
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#pair?', the predicate is called with an argument of type `float' and will always return false
+    pair
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#list?', the predicate is called with an argument of type `null' and will always return true
+  The given argument has type
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#list?', the predicate is called with an argument of type `null' and will always return true
+    pair
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#list?', the predicate is called with an argument of type `fixnum' and will always return false
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#list?', the predicate is called with an argument of type `float' and will always return false
+    (scheme#pair? l)
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#null?', the predicate is called with an argument of type `null' and will always return true
+  Predicate call will always return false.
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#null?', the predicate is called with an argument of type `null' and will always return true
+  Procedure `scheme#pair?' is a predicate for
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#null?', the predicate is called with an argument of type `pair' and will always return false
+    pair
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#null?', the predicate is called with an argument of type `fixnum' and will always return false
+  The given argument has type
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#null?', the predicate is called with an argument of type `float' and will always return false
+    null
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `chicken.base#fixnum?', the predicate is called with an argument of type `fixnum' and will always return true
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `chicken.base#fixnum?', the predicate is called with an argument of type `float' and will always return false
+    (scheme#pair? n)
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `chicken.base#flonum?', the predicate is called with an argument of type `float' and will always return true
+  Predicate call will always return false.
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `chicken.base#flonum?', the predicate is called with an argument of type `fixnum' and will always return false
+  Procedure `scheme#pair?' is a predicate for
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#number?', the predicate is called with an argument of type `fixnum' and will always return true
+    pair
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#number?', the predicate is called with an argument of type `float' and will always return true
+  The given argument has type
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#number?', the predicate is called with an argument of type `number' and will always return true
+    null
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:XXX) in procedure call to `scheme#number?', the predicate is called with an argument of type `null' and will always return false
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#pair? i)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#pair?' is a predicate for
+
+    pair
+
+  The given argument has type
+
+    fixnum
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#pair? f)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#pair?' is a predicate for
+
+    pair
+
+  The given argument has type
+
+    float
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#list? l)
+
+  Predicate call will always return true.
+
+  Procedure `scheme#list?' is a predicate for
+
+    list
+
+  The given argument has type
+
+    null
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#list? n)
+
+  Predicate call will always return true.
+
+  Procedure `scheme#list?' is a predicate for
+
+    list
+
+  The given argument has type
+
+    null
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#list? i)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#list?' is a predicate for
+
+    list
+
+  The given argument has type
+
+    fixnum
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#list? f)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#list?' is a predicate for
+
+    list
+
+  The given argument has type
+
+    float
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#null? n)
+
+  Predicate call will always return true.
+
+  Procedure `scheme#null?' is a predicate for
+
+    null
+
+  The given argument has type
+
+    null
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#null? l)
+
+  Predicate call will always return true.
+
+  Procedure `scheme#null?' is a predicate for
+
+    null
+
+  The given argument has type
+
+    null
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#null? p)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#null?' is a predicate for
+
+    null
+
+  The given argument has type
+
+    pair
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#null? i)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#null?' is a predicate for
+
+    null
+
+  The given argument has type
+
+    fixnum
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#null? f)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#null?' is a predicate for
+
+    null
+
+  The given argument has type
+
+    float
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (chicken.base#fixnum? i)
+
+  Predicate call will always return true.
+
+  Procedure `chicken.base#fixnum?' is a predicate for
+
+    fixnum
+
+  The given argument has type
+
+    fixnum
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (chicken.base#fixnum? f)
+
+  Predicate call will always return false.
+
+  Procedure `chicken.base#fixnum?' is a predicate for
+
+    fixnum
+
+  The given argument has type
+
+    float
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (chicken.base#flonum? f)
+
+  Predicate call will always return true.
+
+  Procedure `chicken.base#flonum?' is a predicate for
+
+    float
+
+  The given argument has type
+
+    float
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (chicken.base#flonum? i)
+
+  Predicate call will always return false.
+
+  Procedure `chicken.base#flonum?' is a predicate for
+
+    float
+
+  The given argument has type
+
+    fixnum
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#number? i)
+
+  Predicate call will always return true.
+
+  Procedure `scheme#number?' is a predicate for
+
+    number
+
+  The given argument has type
+
+    fixnum
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#number? f)
+
+  Predicate call will always return true.
+
+  Procedure `scheme#number?' is a predicate for
+
+    number
+
+  The given argument has type
+
+    float
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#number? u)
+
+  Predicate call will always return true.
+
+  Procedure `scheme#number?' is a predicate for
+
+    number
+
+  The given argument has type
+
+    number
+
+Note: Type mismatch (scrutiny-tests-2.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#number? n)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#number?' is a predicate for
+
+    number
+
+  The given argument has type
+
+    null
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index bab33e34..1b3f55fa 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -3,215 +3,898 @@
 
 Warning: (scrutiny-tests.scm:XXX) - assignment to imported value binding `car'
 
-Note: in local procedure `c',
-  in local procedure `b',
-  in toplevel procedure `a':
-  expected a value of type boolean in conditional, but was given a value of type `number' which is always true:
+Note: Type mismatch
+  In `a', a toplevel procedure
+  In `b', a local procedure
+  In `c', a local procedure
+  In conditional expression
 
-(if x 1 2)
+    (if x 1 2)
 
-Note: in toplevel procedure `b':
-  expected a value of type boolean in conditional, but was given a value of type `true' which is always true:
+  Test condition has always true value of type
 
-(if x 1 2)
+    number
 
-Warning: in toplevel procedure `foo':
-  branches in conditional expression differ in the number of results:
+Note: Type mismatch
+  In `b', a toplevel procedure
+  In conditional expression
 
-(if x (scheme#values 1 2) (scheme#values 1 2 (scheme#+ (scheme#+ ...))))
+    (if x 1 2)
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `bar', expected argument #2 of type `number' but was given an argument of type `symbol'
+  Test condition has always true value of type
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#string?', expected 1 argument but was given 0 arguments
+    true
 
-Warning: at toplevel:
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo', a toplevel procedure
+  In conditional expression
+
+    (if x (scheme#values 1 2) (scheme#values 1 2 (scheme#+ (scheme#+ ...))))
+
+  The branches have different number of returned values.
+
+  The true branch returns 2 values
+
+    (scheme#values 1 2)
+
+  The false branch returns 3 values
+
+    (scheme#values 1 2 (scheme#+ (scheme#+ (scheme#+ ...))))
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (bar 3 'a)
+
+  Argument #2 to procedure `bar' has invalid type
+
+    symbol
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (scheme#string?)
+
+  Procedure `scheme#string?' is called with 0 arguments but 1 argument is expected.
+
+  The procedure's type is
+
+    (procedure scheme#string? (*) boolean)
+
+Warning: At toplevel
   (scrutiny-tests.scm:XXX) expected a single result in argument #1 of procedure call `(chicken.base#print (scheme#values 1 2))', but received 2 results
 
-Warning: at toplevel:
+Warning: At toplevel
   (scrutiny-tests.scm:XXX) expected a single result in argument #1 of procedure call `(chicken.base#print (scheme#values))', but received zero results
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `x', expected a value of type `(procedure () *)' but was given a value of type `fixnum'
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (x)
+
+  Procedure in a procedure call has invalid type
+
+    fixnum
+
+  The expected type is
+
+    (procedure () *)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (scheme#+ 'a 'b)
+
+  Argument #1 to procedure `scheme#+' has invalid type
+
+    symbol
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (scheme#+ 'a 'b)
+
+  Argument #2 to procedure `scheme#+' has invalid type
+
+    symbol
+
+  The expected type is
+
+    number
+
+  The procedure's type is
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#+', expected argument #1 of type `number' but was given an argument of type `symbol'
+    (procedure scheme#+ (#!rest number) number)
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#+', expected argument #2 of type `number' but was given an argument of type `symbol'
+Warning: Type mismatch
+  At toplevel
+  In assignment
 
-Warning: at toplevel:
-  assignment of value of type `fixnum' to toplevel variable `scheme#car' does not match declared type `(forall (a335) (procedure scheme#car ((pair a335 *)) a335))'
+    (set! scheme#car 33)
 
-Warning: at toplevel:
+  Variable `scheme#car' is assigned invalid value.
+
+  The assigned value has type
+
+    fixnum
+
+  The declared type of `scheme#car' is
+
+    (forall (a335) (procedure scheme#car ((pair a335 *)) a335))
+
+Warning: At toplevel
   expected a single result in `let' binding of `gXXX', but received 2 results
 
-Warning: at toplevel:
-  in procedure call to `gXXX', expected a value of type `(procedure () *)' but was given a value of type `fixnum'
+Warning: Type mismatch
+  At toplevel
+  In procedure call
+
+    (gXXX)
+
+  Procedure in a procedure call has invalid type
+
+    fixnum
+
+  The expected type is
+
+    (procedure () *)
+
+Note: Type mismatch
+  In `foo', a toplevel procedure
+  In conditional expression
+
+    (if bar 3 (##core#undefined))
+
+  Test condition has always true value of type
+
+    (procedure bar () *)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo2', a toplevel procedure
+  In procedure call
+
+    (scheme#string-append x "abc")
+
+  Argument #1 to procedure `scheme#string-append' has invalid type
+
+    number
+
+  The expected type is
+
+    string
+
+  The procedure's type is
+
+    (procedure scheme#string-append (#!rest string) string)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (foo3 99)
+
+  Argument #1 to procedure `foo3' has invalid type
+
+    fixnum
+
+  The expected type is
+
+    string
+
+  The procedure's type is
+
+    (procedure foo3 (string) string)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo4', a toplevel procedure
+  In procedure call
+
+    (scheme#+ x 1)
+
+  Argument #1 to procedure `scheme#+' has invalid type
+
+    string
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo5', a toplevel procedure
+  In procedure call
 
-Note: in toplevel procedure `foo':
-  expected a value of type boolean in conditional, but was given a value of type `(procedure bar () *)' which is always true:
+    (scheme#+ x 3)
 
-(if bar 3 (##core#undefined))
+  Argument #1 to procedure `scheme#+' has invalid type
 
-Warning: in toplevel procedure `foo2':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#string-append', expected argument #1 of type `string' but was given an argument of type `number'
+    string
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `foo3', expected argument #1 of type `string' but was given an argument of type `fixnum'
+  The expected type is
 
-Warning: in toplevel procedure `foo4':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#+', expected argument #1 of type `number' but was given an argument of type `string'
+    number
 
-Warning: in toplevel procedure `foo5':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#+', expected argument #1 of type `number' but was given an argument of type `string'
+  The procedure's type is
 
-Warning: in toplevel procedure `foo6':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#+', expected argument #1 of type `number' but was given an argument of type `string'
+    (procedure scheme#+ (#!rest number) number)
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#+', expected argument #1 of type `number' but was given an argument of type `string'
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo6', a toplevel procedure
+  In procedure call
 
-Warning: in toplevel procedure `foo10':
-  (scrutiny-tests.scm:XXX) in procedure call to `foo9', expected argument #1 of type `string' but was given an argument of type `number'
+    (scheme#+ x 3)
 
-Warning: in toplevel procedure `foo10':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#+', expected argument #1 of type `number' but was given an argument of type `string'
+  Argument #1 to procedure `scheme#+' has invalid type
 
-Warning: in toplevel procedure `foo10':
-  expression returns a result of type `string' but is declared to return `pair', which is not compatible
+    string
 
-Warning: in toplevel procedure `foo10':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#string-append', expected argument #1 of type `string' but was given an argument of type `pair'
+  The expected type is
 
-Warning: in toplevel procedure `foo10':
-  expression returns 2 values but is declared to have a single result
+    number
 
-Warning: in toplevel procedure `foo10':
-  expression returns zero values but is declared to have a single result of type `*'
+  The procedure's type is
 
-Warning: in toplevel procedure `foo10':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#*', expected argument #1 of type `number' but was given an argument of type `string'
+    (procedure scheme#+ (#!rest number) number)
 
-Warning: in toplevel procedure `foo#blabla':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#+', expected argument #2 of type `number' but was given an argument of type `symbol'
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
 
-Warning: at toplevel:
+    (scheme#+ x 1)
+
+  Argument #1 to procedure `scheme#+' has invalid type
+
+    string
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo10', a toplevel procedure
+  In procedure call
+
+    (foo9 x)
+
+  Argument #1 to procedure `foo9' has invalid type
+
+    number
+
+  The expected type is
+
+    string
+
+  The procedure's type is
+
+    (procedure foo9 (string) symbol)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo10', a toplevel procedure
+  In procedure call
+
+    (scheme#+ x 1)
+
+  Argument #1 to procedure `scheme#+' has invalid type
+
+    string
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo10', a toplevel procedure
+  In expression
+
+    (scheme#substring x 0 10)
+
+  Expression's declared and actual types do not match.
+
+  The actual type is
+
+    string
+
+  The expression's declared type is
+
+    pair
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo10', a toplevel procedure
+  In procedure call
+
+    (scheme#string-append (the pair (scheme#substring x 0 10)))
+
+  Argument #1 to procedure `scheme#string-append' has invalid type
+
+    pair
+
+  The expected type is
+
+    string
+
+  The procedure's type is
+
+    (procedure scheme#string-append (#!rest string) string)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo10', a toplevel procedure
+  In expression
+
+    (scheme#values 1 2)
+
+  Expression returns too many values.
+
+  The expression returns 2 values but is declared to return
+
+    *
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo10', a toplevel procedure
+  In expression
+
+    (scheme#values)
+
+  Expression returns 0 values but is declared to return
+
+    *
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo10', a toplevel procedure
+  In procedure call
+
+    (scheme#* x y)
+
+  Argument #1 to procedure `scheme#*' has invalid type
+
+    string
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure scheme#* (#!rest number) number)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `foo#blabla', a toplevel procedure
+  In procedure call
+
+    (scheme#+ 1 'x)
+
+  Argument #2 to procedure `scheme#+' has invalid type
+
+    symbol
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure scheme#+ (#!rest number) number)
+
+Warning: At toplevel
   use of deprecated `deprecated-procedure'
 
-Warning: at toplevel:
+Warning: At toplevel
   use of deprecated `another-deprecated-procedure' - consider `replacement-procedure'
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `apply1', expected argument #2 of type `(list-of number)' but was given an argument of type `(list symbol fixnum fixnum)'
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (apply1 scheme#+ (scheme#list 'a 2 3))
+
+  Argument #2 to procedure `apply1' has invalid type
+
+    (list symbol fixnum fixnum)
+
+  The expected type is
+
+    (list-of number)
+
+  The procedure's type is
+
+    (forall
+      (a143 b144)
+      (procedure apply1 ((procedure (#!rest a143) b144) (list-of a143)) b144))
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (apply1 scheme#+ (scheme#cons 'a (scheme#cons 2 (scheme#cons 3 ...))))
+
+  Argument #2 to procedure `apply1' has invalid type
+
+    (list symbol fixnum fixnum)
+
+  The expected type is
+
+    (list-of number)
+
+  The procedure's type is
+
+    (forall
+      (a143 b144)
+      (procedure apply1 ((procedure (#!rest a143) b144) (list-of a143)) b144))
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `apply1', expected argument #2 of type `(list-of number)' but was given an argument of type `(list symbol fixnum fixnum)'
+Note: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In predicate call
 
-Note: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `chicken.base#fixnum?', the predicate is called with an argument of type `fixnum' and will always return true
+    (chicken.base#fixnum? x)
 
-Note: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `(or char string)' and will always return false
+  Predicate call will always return true.
 
-Note: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#string?', the predicate is called with an argument of type `(not (or char string))' and will always return false
+  Procedure `chicken.base#fixnum?' is a predicate for
 
-Note: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `char-or-string?', the predicate is called with an argument of type `fixnum' and will always return false
+    fixnum
 
-Note: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `(or char string)' and will always return false
+  The given argument has type
 
-Note: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#string?', the predicate is called with an argument of type `fixnum' and will always return false
+    fixnum
 
-Note: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `char' and will always return false
+Note: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In predicate call
 
-Note: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#string?', the predicate is called with an argument of type `symbol' and will always return false
+    (scheme#symbol? x)
 
-Note: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `(or char string)' and will always return false
+  Predicate call will always return false.
 
-Note: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#string?', the predicate is called with an argument of type `symbol' and will always return false
+  Procedure `scheme#symbol?' is a predicate for
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `f', expected argument #1 of type `pair' but was given an argument of type `null'
+    symbol
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `f', expected argument #1 of type `null' but was given an argument of type `(list fixnum)'
+  The given argument has type
 
-Warning: at toplevel:
-  (scrutiny-tests.scm:XXX) in procedure call to `f', expected argument #1 of type `list' but was given an argument of type `(pair fixnum fixnum)'
+    (or char string)
 
-Warning: in toplevel procedure `vector-ref-warn1':
+Note: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#string? x)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#string?' is a predicate for
+
+    string
+
+  The given argument has type
+
+    (not (or char string))
+
+Note: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (char-or-string? x)
+
+  Predicate call will always return false.
+
+  Procedure `char-or-string?' is a predicate for
+
+    (or char string)
+
+  The given argument has type
+
+    fixnum
+
+Note: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#symbol? x)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#symbol?' is a predicate for
+
+    symbol
+
+  The given argument has type
+
+    (or char string)
+
+Note: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#string? x)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#string?' is a predicate for
+
+    string
+
+  The given argument has type
+
+    fixnum
+
+Note: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#symbol? x)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#symbol?' is a predicate for
+
+    symbol
+
+  The given argument has type
+
+    char
+
+Note: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#string? x)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#string?' is a predicate for
+
+    string
+
+  The given argument has type
+
+    symbol
+
+Note: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#symbol? x)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#symbol?' is a predicate for
+
+    symbol
+
+  The given argument has type
+
+    (or char string)
+
+Note: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#string? x)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#string?' is a predicate for
+
+    string
+
+  The given argument has type
+
+    symbol
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (f (scheme#list))
+
+  Argument #1 to procedure `f' has invalid type
+
+    null
+
+  The expected type is
+
+    pair
+
+  The procedure's type is
+
+    (procedure (pair) *)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (f (scheme#list 1))
+
+  Argument #1 to procedure `f' has invalid type
+
+    (list fixnum)
+
+  The expected type is
+
+    null
+
+  The procedure's type is
+
+    (procedure (null) *)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  At toplevel
+  In procedure call
+
+    (f (scheme#cons 1 2))
+
+  Argument #1 to procedure `f' has invalid type
+
+    (pair fixnum fixnum)
+
+  The expected type is
+
+    list
+
+  The procedure's type is
+
+    (procedure (list) *)
+
+Warning: In `vector-ref-warn1', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#vector-ref', index -1 out of range for vector of length 3
 
-Warning: in toplevel procedure `vector-ref-warn2':
+Warning: In `vector-ref-warn2', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#vector-ref', index 3 out of range for vector of length 3
 
-Warning: in toplevel procedure `vector-ref-warn3':
+Warning: In `vector-ref-warn3', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#vector-ref', index 4 out of range for vector of length 3
 
-Warning: in toplevel procedure `vector-ref-standard-warn1':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#vector-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol'
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `vector-ref-standard-warn1', a toplevel procedure
+  In procedure call
+
+    (scheme#vector-ref v1 'bad)
+
+  Argument #2 to procedure `scheme#vector-ref' has invalid type
+
+    symbol
+
+  The expected type is
 
-Warning: in toplevel procedure `vector-set!-warn1':
+    fixnum
+
+  The procedure's type is
+
+    (forall (a384) (procedure scheme#vector-ref ((vector-of a384) fixnum) a384))
+
+Warning: In `vector-set!-warn1', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#vector-set!', index -1 out of range for vector of length 3
 
-Warning: in toplevel procedure `vector-set!-warn2':
+Warning: In `vector-set!-warn2', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#vector-set!', index 3 out of range for vector of length 3
 
-Warning: in toplevel procedure `vector-set!-warn3':
+Warning: In `vector-set!-warn3', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#vector-set!', index 4 out of range for vector of length 3
 
-Warning: in toplevel procedure `vector-set!-standard-warn1':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#vector-set!', expected argument #2 of type `fixnum' but was given an argument of type `symbol'
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `vector-set!-standard-warn1', a toplevel procedure
+  In procedure call
+
+    (scheme#vector-set! v1 'bad 'whatever)
+
+  Argument #2 to procedure `scheme#vector-set!' has invalid type
 
-Warning: in toplevel procedure `list-ref-warn1':
+    symbol
+
+  The expected type is
+
+    fixnum
+
+  The procedure's type is
+
+    (procedure scheme#vector-set! (vector fixnum *) undefined)
+
+Warning: In `list-ref-warn1', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#list-ref', index -1 is negative, which is never valid
 
-Warning: in toplevel procedure `list-ref-warn2':
+Warning: In `list-ref-warn2', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#list-ref', index -1 is negative, which is never valid
 
-Warning: in toplevel procedure `list-ref-warn3':
+Warning: In `list-ref-warn3', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#list-ref', index -1 is negative, which is never valid
 
-Warning: in toplevel procedure `list-ref-warn4':
+Warning: In `list-ref-warn4', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#list-ref', index 3 out of range for proper list of length 3
 
-Warning: in toplevel procedure `list-ref-warn5':
+Warning: In `list-ref-warn5', a toplevel procedure
   (scrutiny-tests.scm:XXX) in procedure call to `scheme#list-ref', index 4 out of range for proper list of length 3
 
-Warning: in toplevel procedure `list-ref-standard-warn1':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol'
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `list-ref-standard-warn1', a toplevel procedure
+  In procedure call
+
+    (scheme#list-ref l1 'bad)
+
+  Argument #2 to procedure `scheme#list-ref' has invalid type
+
+    symbol
+
+  The expected type is
+
+    fixnum
+
+  The procedure's type is
+
+    (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `list-ref-standard-warn2', a toplevel procedure
+  In procedure call
+
+    (scheme#list-ref l1 'bad)
+
+  Argument #2 to procedure `scheme#list-ref' has invalid type
+
+    symbol
+
+  The expected type is
+
+    fixnum
+
+  The procedure's type is
+
+    (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `list-ref-standard-warn3', a toplevel procedure
+  In procedure call
+
+    (scheme#list-ref l2 'bad)
+
+  Argument #2 to procedure `scheme#list-ref' has invalid type
+
+    symbol
+
+  The expected type is
+
+    fixnum
+
+  The procedure's type is
+
+    (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `list-ref-standard-warn4', a toplevel procedure
+  In procedure call
+
+    (scheme#list-ref l2 'bad)
+
+  Argument #2 to procedure `scheme#list-ref' has invalid type
+
+    symbol
+
+  The expected type is
+
+    fixnum
+
+  The procedure's type is
+
+    (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `list-ref-type-warn1', a toplevel procedure
+  In procedure call
+
+    (chicken.base#add1 (scheme#list-ref l1 1))
+
+  Argument #1 to procedure `chicken.base#add1' has invalid type
+
+    symbol
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure chicken.base#add1 (number) number)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `list-ref-type-warn2', a toplevel procedure
+  In procedure call
+
+    (chicken.base#add1 (scheme#list-ref l2 1))
+
+  Argument #1 to procedure `chicken.base#add1' has invalid type
+
+    symbol
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure chicken.base#add1 (number) number)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `list-ref-type-warn3', a toplevel procedure
+  In procedure call
+
+    (chicken.base#add1 (scheme#list-ref l3 1))
+
+  Argument #1 to procedure `chicken.base#add1' has invalid type
+
+    symbol
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure chicken.base#add1 (number) number)
+
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `append-result-type-warn1', a toplevel procedure
+  In procedure call
+
+    (chicken.base#add1 (scheme#list-ref l1 1))
+
+  Argument #1 to procedure `chicken.base#add1' has invalid type
+
+    symbol
+
+  The expected type is
+
+    number
+
+  The procedure's type is
+
+    (procedure chicken.base#add1 (number) number)
 
-Warning: in toplevel procedure `list-ref-standard-warn2':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol'
+Warning: Type mismatch (scrutiny-tests.scm:XXX) 
+  In `append-result-type-warn2', a toplevel procedure
+  In procedure call
 
-Warning: in toplevel procedure `list-ref-standard-warn3':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol'
+    (chicken.base#add1 (scheme#list-ref l3 3))
 
-Warning: in toplevel procedure `list-ref-standard-warn4':
-  (scrutiny-tests.scm:XXX) in procedure call to `scheme#list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol'
+  Argument #1 to procedure `chicken.base#add1' has invalid type
 
-Warning: in toplevel procedure `list-ref-type-warn1':
-  (scrutiny-tests.scm:XXX) in procedure call to `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol'
+    symbol
 
-Warning: in toplevel procedure `list-ref-type-warn2':
-  (scrutiny-tests.scm:XXX) in procedure call to `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol'
+  The expected type is
 
-Warning: in toplevel procedure `list-ref-type-warn3':
-  (scrutiny-tests.scm:XXX) in procedure call to `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol'
+    number
 
-Warning: in toplevel procedure `append-result-type-warn1':
-  (scrutiny-tests.scm:XXX) in procedure call to `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol'
+  The procedure's type is
 
-Warning: in toplevel procedure `append-result-type-warn2':
-  (scrutiny-tests.scm:XXX) in procedure call to `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol'
+    (procedure chicken.base#add1 (number) number)
 
 Warning: redefinition of standard binding: scheme#car
diff --git a/tests/specialization.expected b/tests/specialization.expected
index eff536eb..6f8fe43a 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -1,34 +1,104 @@
 ;; numbers replaced with XXX by redact-gensyms.scm
 ;; prefixes: (tmp g scm:)
 
-Note: at toplevel:
-  (specialization-tests.scm:XXX) in procedure call to `scheme#string?', the predicate is called with an argument of type `string' and will always return true
+Note: Type mismatch (specialization-tests.scm:XXX) 
+  At toplevel
+  In predicate call
 
-Note: at toplevel:
-  (specialization-tests.scm:XXX) expected a value of type boolean in conditional, but was given a value of type `true' which is always true:
+    (scheme#string? a)
 
-(if (scheme#string? a) 'ok 'no)
+  Predicate call will always return true.
 
-Note: at toplevel:
-  (specialization-tests.scm:XXX) in procedure call to `scheme#string?', the predicate is called with an argument of type `symbol' and will always return false
+  Procedure `scheme#string?' is a predicate for
 
-Note: at toplevel:
-  (specialization-tests.scm:XXX) in conditional, test expression will always return false:
+    string
 
-(if (scheme#string? a) 'ok 'no)
+  The given argument has type
 
-Note: at toplevel:
-  (specialization-tests.scm:XXX) in procedure call to `scheme#input-port?', the predicate is called with an argument of type `input/output-port' and will always return true
+    string
 
-Note: at toplevel:
-  (specialization-tests.scm:XXX) expected a value of type boolean in conditional, but was given a value of type `true' which is always true:
+Note: Type mismatch (specialization-tests.scm:XXX) 
+  At toplevel
+  In conditional expression
 
-(if (scheme#input-port? p) 'ok 'no)
+    (if (scheme#string? a) 'ok 'no)
 
-Note: at toplevel:
-  (specialization-tests.scm:XXX) in procedure call to `scheme#output-port?', the predicate is called with an argument of type `input/output-port' and will always return true
+  Test condition has always true value of type
 
-Note: at toplevel:
-  (specialization-tests.scm:XXX) expected a value of type boolean in conditional, but was given a value of type `true' which is always true:
+    true
 
-(if (scheme#output-port? p) 'ok 'no)
+Note: Type mismatch (specialization-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#string? a)
+
+  Predicate call will always return false.
+
+  Procedure `scheme#string?' is a predicate for
+
+    string
+
+  The given argument has type
+
+    symbol
+
+Note: Type mismatch (specialization-tests.scm:XXX) 
+  At toplevel
+  In conditional expression
+
+    (if (scheme#string? a) 'ok 'no)
+
+  Test condition is always false.
+
+Note: Type mismatch (specialization-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#input-port? p)
+
+  Predicate call will always return true.
+
+  Procedure `scheme#input-port?' is a predicate for
+
+    input-port
+
+  The given argument has type
+
+    input/output-port
+
+Note: Type mismatch (specialization-tests.scm:XXX) 
+  At toplevel
+  In conditional expression
+
+    (if (scheme#input-port? p) 'ok 'no)
+
+  Test condition has always true value of type
+
+    true
+
+Note: Type mismatch (specialization-tests.scm:XXX) 
+  At toplevel
+  In predicate call
+
+    (scheme#output-port? p)
+
+  Predicate call will always return true.
+
+  Procedure `scheme#output-port?' is a predicate for
+
+    output-port
+
+  The given argument has type
+
+    input/output-port
+
+Note: Type mismatch (specialization-tests.scm:XXX) 
+  At toplevel
+  In conditional expression
+
+    (if (scheme#output-port? p) 'ok 'no)
+
+  Test condition has always true value of type
+
+    true