chicken-hackers
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Chicken-hackers] [PATCH] Use vertical space more liberally in some


From: megane
Subject: Re: [Chicken-hackers] [PATCH] Use vertical space more liberally in some scrutinizer messages
Date: Mon, 10 Dec 2018 19:06:21 +0200
User-agent: mu4e 1.0; emacs 25.1.1

Hello,

Here's the "second half" of this pretty-print-type-messages exercise.

Included is the fix to #1564 (0011). This interacts with the final
commit (0012) that strips (unnecessary) gensym names from type
variables. I.e. 'a123 gets converted to 'a, when possible.

Again, lots of code. It's mostly just simple refactoring and formatting
strings. I tried to rebase this into an easy-to-review format, but
naturally feel free to ask for clarifications.


>From 63d8dc0e1c16b8d7cb920fe485f899d22c5e45e4 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 13:33:18 +0200
Subject: [PATCH 01/12] * [tests] test-scrutinizer-message-format.scm: Trigger
 more messages

(The old append-invalid-last-arg wasn't triggering because the special
case triggers on non-last argument to 'append'.)
---
 tests/scrutinizer-message-format.expected | 253 ++++++++++++++++--------------
 tests/test-scrutinizer-message-format.scm |  52 +++---
 2 files changed, 169 insertions(+), 136 deletions(-)

diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index c050112..355a9aa 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -69,9 +69,6 @@ Warning: Type mismatch.
 
     (scheme#values)
 
-Warning: In `r-proc-call-argument-value-count', a toplevel procedure
-  expected a single result in `let' binding of `g28', but received zero results
-
 Warning: Type mismatch.
     (test-scrutinizer-message-format.scm:12) 
     In `r-cond-branch-value-count-mismatch', a toplevel procedure
@@ -262,43 +259,15 @@ Warning: Type mismatch.
 
     boolean
 
-Warning: In `list-ref-negative-index', a toplevel procedure
-  (test-scrutinizer-message-format.scm:26) in procedure call to 
`scheme#list-ref', index -1 is negative, which is never valid
-
-Warning: In `list-ref-out-of-range', a toplevel procedure
-  (test-scrutinizer-message-format.scm:27) in procedure call to 
`scheme#list-ref', index 1 out of range for proper list of length 0
-
-Warning: In `vector-ref-out-of-range', a toplevel procedure
-  (test-scrutinizer-message-format.scm:29) in procedure call to 
`scheme#vector-ref', index -1 out of range for vector of length 0
+Warning: In `append-invalid-arg', a toplevel procedure
+  (test-scrutinizer-message-format.scm:26) in procedure call to 
`scheme#append', argument #1 is of type
 
-Warning: In `zero-values-for-let', a toplevel procedure
-  expected a single result in `let' binding of `a', but received zero results
+  fixnum
 
-Warning: In `multiple-values-for-let', a toplevel procedure
-  expected a single result in `let' binding of `a', but received 2 results
-
-Warning: In `zero-values-for-conditional', a toplevel procedure
-  expected a single result in conditional, but received zero results
-
-Warning: In `multiple-values-for-conditional', a toplevel procedure
-  expected a single result in conditional, but received 2 results
-
-Note: Type mismatch.
-    (test-scrutinizer-message-format.scm:33) 
-    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: In `multiple-values-for-conditional', a toplevel procedure
-  expected a single result in `let' binding of `g265', but received 2 results
+  but expected a proper list.
 
 Warning: Type mismatch.
-    (test-scrutinizer-message-format.scm:52) 
+    (test-scrutinizer-message-format.scm:45) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-proc-call-argument-count-mismatch', a local procedure
@@ -313,28 +282,28 @@ Warning: Type mismatch.
     ('a 'b --> (pair 'a 'b))
 
 Warning: Type mismatch.
-    (test-scrutinizer-message-format.scm:53) 
+    (test-scrutinizer-message-format.scm:46) 
     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
 
-      (scheme#length 'symbol)
+      (scheme#string-length chicken.base#add1)
 
-  Argument #1 to procedure `length' has invalid type
+  Argument #1 to procedure `string-length' has invalid type
 
-    symbol
+    (procedure chicken.base#add1 (number) number)
 
   The expected type is
 
-    list
+    string
 
-  Procedure `length' from module `scheme' has this type
+  Procedure `string-length' from module `scheme' has this type
 
-    (list -> fixnum)
+    (string -> fixnum)
 
 Warning: Type mismatch.
-    (test-scrutinizer-message-format.scm:54) 
+    (test-scrutinizer-message-format.scm:47) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-proc-call-argument-value-count', a local procedure
@@ -353,7 +322,7 @@ Warning: Type mismatch.
     (chicken.time#cpu-time)
 
 Warning: Type mismatch.
-    (test-scrutinizer-message-format.scm:54) 
+    (test-scrutinizer-message-format.scm:47) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-proc-call-argument-value-count', a local procedure
@@ -371,13 +340,8 @@ Warning: Type mismatch.
 
     (scheme#values)
 
-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 `g90', but received zero results
-
 Warning: Type mismatch.
-    (test-scrutinizer-message-format.scm:55) 
+    (test-scrutinizer-message-format.scm:48) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-cond-branch-value-count-mismatch', a local procedure
@@ -396,9 +360,28 @@ Warning: Type mismatch.
     (chicken.time#cpu-time)
 
 Warning: Type mismatch.
+    (test-scrutinizer-message-format.scm:50) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `r-invalid-called-procedure-type', a local procedure
+    In `variable', a local procedure
+    In procedure call
+
+      (m#foo2 2)
+
+  Procedure in a procedure call has invalid type
+
+    boolean
+
+  The expected type is
+
+    (* -> *)
+
+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 `non-variable', a local procedure
     In procedure call
 
       (1 2)
@@ -412,7 +395,7 @@ Warning: Type mismatch.
     (* -> *)
 
 Note: Type mismatch.
-    (test-scrutinizer-message-format.scm:57) 
+    (test-scrutinizer-message-format.scm:52) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-pred-call-always-true', a local procedure
@@ -431,7 +414,7 @@ Note: Type mismatch.
     null
 
 Note: Type mismatch.
-    (test-scrutinizer-message-format.scm:58) 
+    (test-scrutinizer-message-format.scm:53) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-pred-call-always-false', a local procedure
@@ -450,7 +433,7 @@ Note: Type mismatch.
     fixnum
 
 Note: Type mismatch.
-    (test-scrutinizer-message-format.scm:59) 
+    (test-scrutinizer-message-format.scm:54) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-cond-test-always-true', a local procedure
@@ -491,153 +474,193 @@ Warning: Type mismatch.
     symbol
 
 Warning: Type mismatch.
-    (test-scrutinizer-message-format.scm:62) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
-    In `r-zero-values-for-the', a local procedure
-    In expression
+    In `r-toplevel-var-assignment-type-mismatch', a local procedure
+    In assignment
 
-      (scheme#values)
+      (set! m#foo2 1)
 
-  Expression returns 0 values but is declared to return
+  Variable `m#foo2' is assigned invalid value.
 
-    symbol
+  The assigned value has this type
+
+    fixnum
+
+  The declared type of `m#foo2' is
+
+    boolean
 
 Warning: Type mismatch.
-    (test-scrutinizer-message-format.scm:63) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
-    In `r-too-many-values-for-the', a local procedure
+    In `r-deprecated-identifier', a local procedure
     In expression
 
-      (scheme#values 1 2)
-
-  Expression returns too many values.
-
-  The expression returns 2 values but is declared to return
+      m#deprecated-foo
 
-    symbol
+  Use of deprecated `deprecated-foo' from module `m'.
 
 Warning: Type mismatch.
-    (test-scrutinizer-message-format.scm:63) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
-    In `r-too-many-values-for-the', a local procedure
+    In `r-deprecated-identifier', a local procedure
     In expression
 
-      (scheme#values 1 2)
-
-  Expression's declared and actual types do not match.
-
-  The actual type is
-
-    fixnum
+      m#deprecated-foo2
 
-  The expression's declared type is
+  Use of deprecated `deprecated-foo2' from module `m'.
 
-    symbol
+  The suggested replacement is `foo'.
 
 Warning: Type mismatch.
+    (test-scrutinizer-message-format.scm:60) 
     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
+    In `r-zero-values-for-the', a local procedure
+    In expression
 
-      (set! m#foo2 1)
+      (scheme#values)
 
-  Variable `m#foo2' is assigned invalid value.
+  Expression returns 0 values but is declared to return
 
-  The assigned value has this type
+    symbol
 
-    fixnum
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `zero-values-for-assignment', a local procedure
+  expected a single result in assignment to `m#foo', but received zero results
 
-  The declared type of `m#foo2' is
+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
 
-    boolean
+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: Type mismatch.
+    (test-scrutinizer-message-format.scm:65) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
-    In `r-deprecated-identifier', a local procedure
+    In `r-too-many-values-for-the', a local procedure
     In expression
 
-      m#deprecated-foo
+      (scheme#values 1 2)
 
-  Use of deprecated `deprecated-foo' from module `m'.
+  Expression returns too many values.
+
+  The expression returns 2 values but is declared to return
+
+    symbol
 
 Warning: Type mismatch.
+    (test-scrutinizer-message-format.scm:65) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
-    In `r-deprecated-identifier', a local procedure
+    In `r-too-many-values-for-the', a local procedure
     In expression
 
-      m#deprecated-foo2
+      (scheme#values 1 2)
 
-  Use of deprecated `deprecated-foo2' from module `m'.
+  Expression's declared and actual types do not match.
 
-  The suggested replacement is `foo'.
+  The actual type is
+
+    fixnum
+
+  The expression's declared type is
+
+    symbol
 
 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:67) in procedure call to 
`scheme#list-ref', index -1 is negative, which is never valid
+  In `too-many-values-for-assignment', a local procedure
+  expected a single result in assignment to `m#foo', but received 2 results
 
 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:68) in procedure call to 
`scheme#list-ref', index 1 out of range for proper list of length 0
+  In `too-many-values-for-conditional', a local procedure
+  expected a single result in conditional, but received 2 results
 
 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:70) in procedure call to 
`scheme#vector-ref', index -1 out of range for vector of length 0
+  In `too-many-values-for-let', a local procedure
+  expected a single result in `let' binding of `a', but received 2 results
 
 Warning: In `m#toplevel-foo', a toplevel procedure
   In `local-bar', a local procedure
+  In `r-let-value-count-invalid', 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 `m#toplevel-foo', a toplevel procedure
   In `local-bar', a local procedure
-  In `multiple-values-for-let', a local procedure
+  In `r-let-value-count-invalid', a local procedure
+  In `too-many-values-for-let', a local procedure
   expected a single result in `let' binding of `a', but received 2 results
 
 Warning: In `m#toplevel-foo', a toplevel procedure
   In `local-bar', a local procedure
+  In `r-conditional-value-count-invalid', a local procedure
   In `zero-values-for-conditional', a local procedure
   expected a single result in conditional, but received zero results
 
 Warning: In `m#toplevel-foo', a toplevel procedure
   In `local-bar', a local procedure
-  In `multiple-values-for-conditional', a local procedure
+  In `r-conditional-value-count-invalid', a local procedure
+  In `too-many-values-for-conditional', a local procedure
   expected a single result in conditional, but received 2 results
 
-Note: Type mismatch.
-    (test-scrutinizer-message-format.scm:74) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `multiple-values-for-conditional', a local procedure
-    In conditional expression
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-assignment-value-count-invalid', a local procedure
+  In `zero-values-for-assignment', a local procedure
+  expected a single result in assignment to `m#foo', but received zero results
 
-      (if (scheme#values 1 2) 1 (##core#undefined))
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `r-assignment-value-count-invalid', a local procedure
+  In `too-many-values-for-assignment', a local procedure
+  expected a single result in assignment to `m#foo', but received 2 results
 
-  Test condition has always true value of type
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `append-invalid-arg', a local procedure
+  (test-scrutinizer-message-format.scm:80) in procedure call to 
`scheme#append', argument #1 is of type
 
-    fixnum
+  fixnum
+
+  but expected a proper list.
+
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `vector-list-out-of-range', a local procedure
+  In `list-ref-negative-index', a local procedure
+  (test-scrutinizer-message-format.scm:82) in procedure call to 
`scheme#list-ref', index -1 is negative, which is never valid
 
 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 `let' binding of `g276', but received 2 results
+  In `vector-list-out-of-range', a local procedure
+  In `list-ref-out-of-range', a local procedure
+  (test-scrutinizer-message-format.scm:83) in procedure call to 
`scheme#list-ref', index 1 out of range for proper list of length 0
+
+Warning: In `m#toplevel-foo', a toplevel procedure
+  In `local-bar', a local procedure
+  In `vector-list-out-of-range', a local procedure
+  In `vector-ref-out-of-range', a local procedure
+  (test-scrutinizer-message-format.scm:84) in procedure call to 
`scheme#vector-ref', index -1 out of range for vector of length 0
 
 Error: Type mismatch.
-    (test-scrutinizer-message-format.scm:76) 
+    (test-scrutinizer-message-format.scm:86) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `fail-compiler-typecase', a local procedure
     In `compiler-typecase' expression
 
-      (compiler-typecase g97 (symbol 1) (list 2) (else (##core#undefined)))
+      (compiler-typecase g104 (symbol 1) (list 2) (else (##core#undefined)))
 
   Tested expression in `compiler-typecase' does not match any case.
 
diff --git a/tests/test-scrutinizer-message-format.scm 
b/tests/test-scrutinizer-message-format.scm
index 0c45194..37dbcd2 100644
--- a/tests/test-scrutinizer-message-format.scm
+++ b/tests/test-scrutinizer-message-format.scm
@@ -8,7 +8,7 @@
 
 (define (r-proc-call-argument-count-mismatch) (cons '()))
 (define (r-proc-call-argument-type-mismatch) (length 'symbol))
-(define (r-proc-call-argument-value-count) (list (cpu-time)) (vector (values)) 
((values)))
+(define (r-proc-call-argument-value-count) (list (cpu-time)) (vector (values)))
 (define (r-cond-branch-value-count-mismatch) (if (the * 1) 1 (cpu-time)))
 (define (r-invalid-called-procedure-type) (1 2))
 (define (r-pred-call-always-true) (list? '()))
@@ -23,14 +23,7 @@
 
 (set! foo 1)
 
-(define (list-ref-negative-index) (list-ref '() -1))
-(define (list-ref-out-of-range) (list-ref '() 1))
-(define (append-invalid-last-arg) (scheme#append (list 1) 1)) ;; TODO: doesn't 
work
-(define (vector-ref-out-of-range) (vector-ref (vector) -1))
-(define (zero-values-for-let) (let ((a (values))) a))
-(define (multiple-values-for-let) (let ((a (values 1 2))) a))
-(define (zero-values-for-conditional) (if (values) 1))
-(define (multiple-values-for-conditional) (if (values 1 2) 1))
+(define (append-invalid-arg) (append 1 (list 1)))
 
 ;; (define (fail-compiler-typecase) (compiler-typecase 1 (symbol 1) (list 2)))
 
@@ -50,28 +43,45 @@
  (define (toplevel-foo)
    (define (local-bar)
      (define (r-proc-call-argument-count-mismatch) (cons '()))
-     (define (r-proc-call-argument-type-mismatch) (length 'symbol))
-     (define (r-proc-call-argument-value-count) (list (cpu-time)) (vector 
(values)) ((values)))
+     (define (r-proc-call-argument-type-mismatch) (string-length add1))
+     (define (r-proc-call-argument-value-count) (list (cpu-time)) (vector 
(values)))
      (define (r-cond-branch-value-count-mismatch) (if (the * 1) 1 (cpu-time)))
-     (define (r-invalid-called-procedure-type) (1 2))
+     (define (r-invalid-called-procedure-type)
+       (define (variable) (foo2 2))
+       (define (non-variable) (1 2)))
      (define (r-pred-call-always-true) (list? '()))
      (define (r-pred-call-always-false) (symbol? 1))
      (define (r-cond-test-always-true) (if (length '()) 1))
      (define (r-cond-test-always-false) (if #f 1))
      (define (r-type-mismatch-in-the) (the symbol 1))
-     (define (r-zero-values-for-the) (the symbol (values)))
-     (define (r-too-many-values-for-the) (the symbol (values 1 2)))
      (define (r-toplevel-var-assignment-type-mismatch) (set! foo2 1))
      (define (r-deprecated-identifier) (list deprecated-foo) (vector 
deprecated-foo2))
 
-     (define (list-ref-negative-index) (list-ref '() -1))
-     (define (list-ref-out-of-range) (list-ref '() 1))
-     (define (append-invalid-last-arg) (scheme#append (list 1) 1)) ;; TODO: 
doesn't work
-     (define (vector-ref-out-of-range) (vector-ref (vector) -1))
-     (define (zero-values-for-let) (let ((a (values))) a))
-     (define (multiple-values-for-let) (let ((a (values 1 2))) a))
+     (define (r-zero-values-for-the) (the symbol (values)))
+     (define (zero-values-for-assignment) (set! foo (values)))
      (define (zero-values-for-conditional) (if (values) 1))
-     (define (multiple-values-for-conditional) (if (values 1 2) 1))
+     (define (zero-values-for-let) (let ((a (values))) a))
+
+     (define (r-too-many-values-for-the) (the symbol (values 1 2)))
+     (define (too-many-values-for-assignment) (set! foo (values #t 2)))
+     (define (too-many-values-for-conditional) (if (values (the * 1) 2) 1))
+     (define (too-many-values-for-let) (let ((a (values 1 2))) a))
+
+     (define (r-let-value-count-invalid)
+       (define (zero-values-for-let) (let ((a (values))) a))
+       (define (too-many-values-for-let) (let ((a (values 1 2))) a)))
+     (define (r-conditional-value-count-invalid)
+       (define (zero-values-for-conditional) (if (values) 1))
+       (define (too-many-values-for-conditional) (if (values (the * 1) 2) 1)))
+     (define (r-assignment-value-count-invalid)
+       (define (zero-values-for-assignment) (set! foo (values)))
+       (define (too-many-values-for-assignment) (set! foo (values #t 2))))
+
+     (define (append-invalid-arg) (append 1 (list 1)))
+     (define (vector-list-out-of-range)
+       (define (list-ref-negative-index) (list-ref '() -1))
+       (define (list-ref-out-of-range) (list-ref '() 1))
+       (define (vector-ref-out-of-range) (vector-ref (vector) -1)))
 
      (define (fail-compiler-typecase) (compiler-typecase 1 (symbol 1) (list 
2)))
      )))
-- 
2.7.4

>From 5b3de62ddca3c51fb50e265df1d606e9198e7c5d Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 15:28:58 +0200
Subject: [PATCH 02/12] * scrutinizer.scm: Add more useful first line for
 messages

* scrutinizer.scm (report2): New argument 'short' for first line of message

* scrutinizer.scm (r-proc-call-argument-value-count): Bit of
  refactoring. The printed 'expression' will be come back in later commit.
---
 scrutinizer.scm                           |  81 +++++++++++----------
 tests/scrutinizer-message-format.expected |  70 +++++++++---------
 tests/scrutiny-2.expected                 |  44 ++++++------
 tests/scrutiny.expected                   | 114 +++++++++++++++---------------
 tests/specialization.expected             |  16 ++---
 5 files changed, 165 insertions(+), 160 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 6f50b19..344b3d1 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2515,7 +2515,7 @@
        (sprintf "`~a' from module `~a'" (second r) (first r))
        (sprintf "`~a'" sym))))
 
-(define (report2 report-f location-node-candidates loc msg . args)
+(define (report2 short 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)))
@@ -2523,20 +2523,21 @@
   (when *complain?*
     (report-f
      (conc
-      "Type mismatch.\n  "
+      (sprintf "~a.\n  " short)
       (string-add-indent
        (conc (let ((l (file-location))) (if l (conc l "\n  ") ""))
             (location-name loc "  ")
             (sprintf "~?" msg args))
        "  ")))))
 
-(define (report-notice location-node-candidates loc msg . args)
-  (apply report2 ##sys#notice location-node-candidates loc msg args))
+(define (report-notice reason location-node-candidates loc msg . args)
+  (apply report2 reason ##sys#notice location-node-candidates loc msg args))
 
 ;;; Reports
 
 (define (r-invalid-called-procedure-type loc node xptype ptype)
   (report2
+   "Invalid procedure"
    warning
    (list node)
    loc
@@ -2558,6 +2559,7 @@
 
 (define (r-proc-call-argument-count-mismatch loc node pname exp-count argc 
ptype)
   (report2
+   "Wrong number of arguments"
    warning
    (list node)
    loc
@@ -2580,6 +2582,7 @@
 
 (define (r-proc-call-argument-type-mismatch loc node pname i xptype atype 
ptype)
   (report2
+   "Invalid argument type"
    warning
    (list node)
    loc
@@ -2635,44 +2638,37 @@
                          (p-expr)))))
        (p-expr)))
 
+  (define (p short long)
+    (report2
+     short
+     warning
+     (list arg-node call-node)
+     loc
+     (string-append
+      "In procedure call"
+      "~%~%"
+      "~a"
+      "~%~%"
+      "Argument #~a to procedure~a ~a"
+      "~%~%"
+      "~a")
+     (pp-fragment call-node "    ")
+     i
+     pn
+     long
+     (p-arg-expr)))
+
   (if (zero? (length atype))
-      (report2
-       warning
-       (list arg-node call-node)
-       loc
-       (string-append
-       "In procedure call"
-       "~%~%"
-       "~a"
-       "~%~%"
-       "Argument expression #~a to procedure~a does not return any values."
-       "~%~%"
-       "~a")
-       (pp-fragment call-node "    ")
-       i
-       pn
-       (p-arg-expr))
-      (report2
-       warning
-       (list arg-node call-node)
-       loc
-       (string-append
-       "In procedure call"
-       "~%~%"
-       "~a"
-       "~%~%"
-       "Argument #~a to procedure~a returns ~a values but 1 is expected."
-       "~%~%"
-       "~a")
-       (pp-fragment call-node "    ")
-       i
-       pn
-       (length atype)
-       (p-arg-expr))))
+      (p "No values returned for argument"
+        "does not return any values.")
+      (p "Too many argument values"
+        (sprintf "returns ~a values but 1 is expected."
+                 (length atype)))))
 
 (define (r-pred-call-always-true loc node pname pred-type atype)
   ;; pname is "... proc call to predicate `foo' "
   (report-notice
+   "Predicate always true"
    (list node)
    loc
    (string-append
@@ -2696,6 +2692,7 @@
 
 (define (r-pred-call-always-false loc node pname pred-type atype)
   (report-notice
+   "Predicate always false"
    (list node)
    loc
    (string-append
@@ -2719,6 +2716,7 @@
 
 (define (r-cond-test-always-true loc if-node test-node t)
   (report-notice
+   "Test always true"
    (list test-node if-node)
    loc
    (string-append
@@ -2734,6 +2732,7 @@
 
 (define (r-cond-test-always-false loc if-node test-node)
   (report-notice
+   "Test always false"
    (list test-node if-node)
    loc
    (string-append
@@ -2747,6 +2746,7 @@
 (define (r-zero-values-for-the loc node the-type)
   ;; (the t r) expects r returns exactly 1 value
   (report2
+   "Zero values returned"
    warning
    (list node)
    loc
@@ -2763,6 +2763,7 @@
 
 (define (r-too-many-values-for-the loc node the-type rtypes)
   (report2
+   "Too many values returned"
    warning
    (list node)
    loc
@@ -2782,6 +2783,7 @@
 
 (define (r-type-mismatch-in-the loc node first-rtype the-type)
   (report2
+   "Type mismatch"
    warning
    (list node)
    loc
@@ -2807,7 +2809,7 @@
   (define (ppt t) (string-add-indent (type->pp-string t) "  "))
   (quit-compiling
    (string-append
-    "Type mismatch.~%"
+    "No typecase matches.~%"
     "~a"
     "    ~a"
     "In `compiler-typecase' expression"
@@ -2833,6 +2835,7 @@
 
 (define (r-cond-branch-value-count-mismatch loc node c-node a-node c-types 
a-types)
   (report2
+   "Branch value count mismatch"
    warning
    (list a-node node)
    loc
@@ -2858,6 +2861,7 @@
 
 (define (r-toplevel-var-assignment-type-mismatch loc node atype var xptype 
value-node)
   (report2
+   "Invalid assigned value type"
    warning
    (list node value-node)
    loc
@@ -2883,6 +2887,7 @@
 
 (define (r-deprecated-identifier loc node id #!optional suggestion)
   (report2
+   (sprintf "Deprecated identifier `~a'" (strip-namespace id))
    warning
    (list node)
    loc
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index 355a9aa..1529058 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -3,7 +3,7 @@ Warning: literal in operator position: (1 2)
 
 Warning: literal in operator position: (1 2)
 
-Warning: Type mismatch.
+Warning: Wrong number of arguments.
     (test-scrutinizer-message-format.scm:9) 
     In `r-proc-call-argument-count-mismatch', a toplevel procedure
     In procedure call
@@ -16,7 +16,7 @@ Warning: Type mismatch.
 
     ('a 'b --> (pair 'a 'b))
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (test-scrutinizer-message-format.scm:10) 
     In `r-proc-call-argument-type-mismatch', a toplevel procedure
     In procedure call
@@ -35,7 +35,7 @@ Warning: Type mismatch.
 
     (list -> fixnum)
 
-Warning: Type mismatch.
+Warning: Too many argument values.
     (test-scrutinizer-message-format.scm:11) 
     In `r-proc-call-argument-value-count', a toplevel procedure
     In procedure call
@@ -52,14 +52,14 @@ Warning: Type mismatch.
 
     (chicken.time#cpu-time)
 
-Warning: Type mismatch.
+Warning: No values returned for argument.
     (test-scrutinizer-message-format.scm:11) 
     In `r-proc-call-argument-value-count', a toplevel procedure
     In procedure call
 
       (scheme#vector (scheme#values))
 
-  Argument expression #1 to procedure `vector' does not return any values.
+  Argument #1 to procedure `vector' does not return any values.
 
   It is a call to `values' from module `scheme' which has this type
 
@@ -69,7 +69,7 @@ Warning: Type mismatch.
 
     (scheme#values)
 
-Warning: Type mismatch.
+Warning: Branch value count mismatch.
     (test-scrutinizer-message-format.scm:12) 
     In `r-cond-branch-value-count-mismatch', a toplevel procedure
     In conditional expression
@@ -86,7 +86,7 @@ Warning: Type mismatch.
 
     (chicken.time#cpu-time)
 
-Warning: Type mismatch.
+Warning: Invalid procedure.
     In `r-invalid-called-procedure-type', a toplevel procedure
     In procedure call
 
@@ -100,7 +100,7 @@ Warning: Type mismatch.
 
     (* -> *)
 
-Note: Type mismatch.
+Note: Predicate always true.
     (test-scrutinizer-message-format.scm:14) 
     In `r-pred-call-always-true', a toplevel procedure
     In predicate call
@@ -117,7 +117,7 @@ Note: Type mismatch.
 
     null
 
-Note: Type mismatch.
+Note: Predicate always false.
     (test-scrutinizer-message-format.scm:15) 
     In `r-pred-call-always-false', a toplevel procedure
     In predicate call
@@ -134,7 +134,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Test always true.
     In `r-cond-test-always-true', a toplevel procedure
     In conditional expression
 
@@ -144,7 +144,7 @@ Note: Type mismatch.
 
     symbol
 
-Note: Type mismatch.
+Note: Test always false.
     In `r-cond-test-always-false', a toplevel procedure
     In conditional expression
 
@@ -168,7 +168,7 @@ Warning: Type mismatch.
 
     symbol
 
-Warning: Type mismatch.
+Warning: Zero values returned.
     (test-scrutinizer-message-format.scm:19) 
     In `r-zero-values-for-the', a toplevel procedure
     In expression
@@ -179,7 +179,7 @@ Warning: Type mismatch.
 
     symbol
 
-Warning: Type mismatch.
+Warning: Too many values returned.
     (test-scrutinizer-message-format.scm:20) 
     In `r-too-many-values-for-the', a toplevel procedure
     In expression
@@ -209,7 +209,7 @@ Warning: Type mismatch.
 
     symbol
 
-Warning: Type mismatch.
+Warning: Invalid assigned value type.
     In `r-toplevel-var-assignment-type-mismatch', a toplevel procedure
     In assignment
 
@@ -225,7 +225,7 @@ Warning: Type mismatch.
 
     boolean
 
-Warning: Type mismatch.
+Warning: Deprecated identifier `deprecated-foo'.
     In `r-deprecated-identifier', a toplevel procedure
     In expression
 
@@ -233,7 +233,7 @@ Warning: Type mismatch.
 
   Use of deprecated `deprecated-foo'.
 
-Warning: Type mismatch.
+Warning: Deprecated identifier `deprecated-foo2'.
     In `r-deprecated-identifier', a toplevel procedure
     In expression
 
@@ -243,7 +243,7 @@ Warning: Type mismatch.
 
   The suggested replacement is `foo'.
 
-Warning: Type mismatch.
+Warning: Invalid assigned value type.
     At toplevel:
     In assignment
 
@@ -266,7 +266,7 @@ Warning: In `append-invalid-arg', a toplevel procedure
 
   but expected a proper list.
 
-Warning: Type mismatch.
+Warning: Wrong number of arguments.
     (test-scrutinizer-message-format.scm:45) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -281,7 +281,7 @@ Warning: Type mismatch.
 
     ('a 'b --> (pair 'a 'b))
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (test-scrutinizer-message-format.scm:46) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -302,7 +302,7 @@ Warning: Type mismatch.
 
     (string -> fixnum)
 
-Warning: Type mismatch.
+Warning: Too many argument values.
     (test-scrutinizer-message-format.scm:47) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -321,7 +321,7 @@ Warning: Type mismatch.
 
     (chicken.time#cpu-time)
 
-Warning: Type mismatch.
+Warning: No values returned for argument.
     (test-scrutinizer-message-format.scm:47) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -330,7 +330,7 @@ Warning: Type mismatch.
 
       (scheme#vector (scheme#values))
 
-  Argument expression #1 to procedure `vector' does not return any values.
+  Argument #1 to procedure `vector' does not return any values.
 
   It is a call to `values' from module `scheme' which has this type
 
@@ -340,7 +340,7 @@ Warning: Type mismatch.
 
     (scheme#values)
 
-Warning: Type mismatch.
+Warning: Branch value count mismatch.
     (test-scrutinizer-message-format.scm:48) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -359,7 +359,7 @@ Warning: Type mismatch.
 
     (chicken.time#cpu-time)
 
-Warning: Type mismatch.
+Warning: Invalid procedure.
     (test-scrutinizer-message-format.scm:50) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -377,7 +377,7 @@ Warning: Type mismatch.
 
     (* -> *)
 
-Warning: Type mismatch.
+Warning: Invalid procedure.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-invalid-called-procedure-type', a local procedure
@@ -394,7 +394,7 @@ Warning: Type mismatch.
 
     (* -> *)
 
-Note: Type mismatch.
+Note: Predicate always true.
     (test-scrutinizer-message-format.scm:52) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -413,7 +413,7 @@ Note: Type mismatch.
 
     null
 
-Note: Type mismatch.
+Note: Predicate always false.
     (test-scrutinizer-message-format.scm:53) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -432,7 +432,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Test always true.
     (test-scrutinizer-message-format.scm:54) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -445,7 +445,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Test always false.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-cond-test-always-false', a local procedure
@@ -473,7 +473,7 @@ Warning: Type mismatch.
 
     symbol
 
-Warning: Type mismatch.
+Warning: Invalid assigned value type.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-toplevel-var-assignment-type-mismatch', a local procedure
@@ -491,7 +491,7 @@ Warning: Type mismatch.
 
     boolean
 
-Warning: Type mismatch.
+Warning: Deprecated identifier `deprecated-foo'.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-deprecated-identifier', a local procedure
@@ -501,7 +501,7 @@ Warning: Type mismatch.
 
   Use of deprecated `deprecated-foo' from module `m'.
 
-Warning: Type mismatch.
+Warning: Deprecated identifier `deprecated-foo2'.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-deprecated-identifier', a local procedure
@@ -513,7 +513,7 @@ Warning: Type mismatch.
 
   The suggested replacement is `foo'.
 
-Warning: Type mismatch.
+Warning: Zero values returned.
     (test-scrutinizer-message-format.scm:60) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -541,7 +541,7 @@ Warning: In `m#toplevel-foo', a toplevel procedure
   In `zero-values-for-let', a local procedure
   expected a single result in `let' binding of `a', but received zero results
 
-Warning: Type mismatch.
+Warning: Too many values returned.
     (test-scrutinizer-message-format.scm:65) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
@@ -653,7 +653,7 @@ Warning: In `m#toplevel-foo', a toplevel procedure
   In `vector-ref-out-of-range', a local procedure
   (test-scrutinizer-message-format.scm:84) in procedure call to 
`scheme#vector-ref', index -1 out of range for vector of length 0
 
-Error: Type mismatch.
+Error: No typecase matches.
     (test-scrutinizer-message-format.scm:86) 
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index b994f5e..15bf0a6 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -1,5 +1,5 @@
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests-2.scm:20) 
     At toplevel:
     In predicate call
@@ -16,7 +16,7 @@ Note: Type mismatch.
 
     pair
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:20) 
     At toplevel:
     In predicate call
@@ -33,7 +33,7 @@ Note: Type mismatch.
 
     null
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:20) 
     At toplevel:
     In predicate call
@@ -50,7 +50,7 @@ Note: Type mismatch.
 
     null
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:20) 
     At toplevel:
     In predicate call
@@ -67,7 +67,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:20) 
     At toplevel:
     In predicate call
@@ -84,7 +84,7 @@ Note: Type mismatch.
 
     float
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests-2.scm:21) 
     At toplevel:
     In predicate call
@@ -101,7 +101,7 @@ Note: Type mismatch.
 
     null
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests-2.scm:21) 
     At toplevel:
     In predicate call
@@ -118,7 +118,7 @@ Note: Type mismatch.
 
     null
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:21) 
     At toplevel:
     In predicate call
@@ -135,7 +135,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:21) 
     At toplevel:
     In predicate call
@@ -152,7 +152,7 @@ Note: Type mismatch.
 
     float
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests-2.scm:22) 
     At toplevel:
     In predicate call
@@ -169,7 +169,7 @@ Note: Type mismatch.
 
     null
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests-2.scm:22) 
     At toplevel:
     In predicate call
@@ -186,7 +186,7 @@ Note: Type mismatch.
 
     null
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:22) 
     At toplevel:
     In predicate call
@@ -203,7 +203,7 @@ Note: Type mismatch.
 
     pair
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:22) 
     At toplevel:
     In predicate call
@@ -220,7 +220,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:22) 
     At toplevel:
     In predicate call
@@ -237,7 +237,7 @@ Note: Type mismatch.
 
     float
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests-2.scm:23) 
     At toplevel:
     In predicate call
@@ -254,7 +254,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:23) 
     At toplevel:
     In predicate call
@@ -271,7 +271,7 @@ Note: Type mismatch.
 
     float
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests-2.scm:25) 
     At toplevel:
     In predicate call
@@ -288,7 +288,7 @@ Note: Type mismatch.
 
     float
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:25) 
     At toplevel:
     In predicate call
@@ -305,7 +305,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests-2.scm:27) 
     At toplevel:
     In predicate call
@@ -322,7 +322,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests-2.scm:27) 
     At toplevel:
     In predicate call
@@ -339,7 +339,7 @@ Note: Type mismatch.
 
     float
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests-2.scm:27) 
     At toplevel:
     In predicate call
@@ -356,7 +356,7 @@ Note: Type mismatch.
 
     number
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests-2.scm:27) 
     At toplevel:
     In predicate call
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index a40c742..9d7b710 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -1,7 +1,7 @@
 
 Warning: (scrutiny-tests.scm:31) - assignment to imported value binding `car'
 
-Note: Type mismatch.
+Note: Test always true.
     In `a', a toplevel procedure
     In `b', a local procedure
     In `c', a local procedure
@@ -13,7 +13,7 @@ Note: Type mismatch.
 
     number
 
-Note: Type mismatch.
+Note: Test always true.
     In `b', a toplevel procedure
     In conditional expression
 
@@ -23,7 +23,7 @@ Note: Type mismatch.
 
     true
 
-Warning: Type mismatch.
+Warning: Branch value count mismatch.
     (scrutiny-tests.scm:16) 
     In `foo', a toplevel procedure
     In conditional expression
@@ -40,7 +40,7 @@ Warning: Type mismatch.
 
     (scheme#values 1 2 (scheme#+ (scheme#+ (scheme#+ ...))))
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:19) 
     At toplevel:
     In procedure call
@@ -59,7 +59,7 @@ Warning: Type mismatch.
 
     (&rest number -> number)
 
-Warning: Type mismatch.
+Warning: Wrong number of arguments.
     (scrutiny-tests.scm:21) 
     At toplevel:
     In procedure call
@@ -72,7 +72,7 @@ Warning: Type mismatch.
 
     (* -> boolean)
 
-Warning: Type mismatch.
+Warning: Too many argument values.
     (scrutiny-tests.scm:23) 
     At toplevel:
     In procedure call
@@ -87,16 +87,16 @@ Warning: Type mismatch.
 
   This is the expression
 
-      (scheme#values 1 2)
+    (scheme#values 1 2)
 
-Warning: Type mismatch.
+Warning: No values returned for argument.
     (scrutiny-tests.scm:24) 
     At toplevel:
     In procedure call
 
       (chicken.base#print (scheme#values))
 
-  Argument expression #1 to procedure `print' does not return any values.
+  Argument #1 to procedure `print' does not return any values.
 
   It is a call to `values' from module `scheme' which has this type
 
@@ -104,9 +104,9 @@ Warning: Type mismatch.
 
   This is the expression
 
-      (scheme#values)
+    (scheme#values)
 
-Warning: Type mismatch.
+Warning: Invalid procedure.
     (scrutiny-tests.scm:27) 
     At toplevel:
     In procedure call
@@ -121,7 +121,7 @@ Warning: Type mismatch.
 
     (-> *)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:29) 
     At toplevel:
     In procedure call
@@ -140,7 +140,7 @@ Warning: Type mismatch.
 
     (&rest number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:29) 
     At toplevel:
     In procedure call
@@ -159,7 +159,7 @@ Warning: Type mismatch.
 
     (&rest number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid assigned value type.
     At toplevel:
     In assignment
 
@@ -178,7 +178,7 @@ Warning: Type mismatch.
 Warning: At toplevel:
   expected a single result in `let' binding of `g19', but received 2 results
 
-Warning: Type mismatch.
+Warning: Invalid procedure.
     At toplevel:
     In procedure call
 
@@ -192,7 +192,7 @@ Warning: Type mismatch.
 
     (-> *)
 
-Note: Type mismatch.
+Note: Test always true.
     In `foo', a toplevel procedure
     In conditional expression
 
@@ -202,7 +202,7 @@ Note: Type mismatch.
 
     (procedure bar () *)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:58) 
     In `foo2', a toplevel procedure
     In procedure call
@@ -221,7 +221,7 @@ Warning: Type mismatch.
 
     (&rest string -> string)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:66) 
     At toplevel:
     In procedure call
@@ -240,7 +240,7 @@ Warning: Type mismatch.
 
     (string -> string)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:71) 
     In `foo4', a toplevel procedure
     In procedure call
@@ -259,7 +259,7 @@ Warning: Type mismatch.
 
     (&rest number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:77) 
     In `foo5', a toplevel procedure
     In procedure call
@@ -278,7 +278,7 @@ Warning: Type mismatch.
 
     (&rest number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:83) 
     In `foo6', a toplevel procedure
     In procedure call
@@ -297,7 +297,7 @@ Warning: Type mismatch.
 
     (&rest number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:90) 
     At toplevel:
     In procedure call
@@ -316,7 +316,7 @@ Warning: Type mismatch.
 
     (&rest number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:104) 
     In `foo10', a toplevel procedure
     In procedure call
@@ -335,7 +335,7 @@ Warning: Type mismatch.
 
     (string -> symbol)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:105) 
     In `foo10', a toplevel procedure
     In procedure call
@@ -371,7 +371,7 @@ Warning: Type mismatch.
 
     pair
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:109) 
     In `foo10', a toplevel procedure
     In procedure call
@@ -390,7 +390,7 @@ Warning: Type mismatch.
 
     (&rest string -> string)
 
-Warning: Type mismatch.
+Warning: Too many values returned.
     (scrutiny-tests.scm:110) 
     In `foo10', a toplevel procedure
     In expression
@@ -403,7 +403,7 @@ Warning: Type mismatch.
 
     *
 
-Warning: Type mismatch.
+Warning: Zero values returned.
     (scrutiny-tests.scm:111) 
     In `foo10', a toplevel procedure
     In expression
@@ -414,7 +414,7 @@ Warning: Type mismatch.
 
     *
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:112) 
     In `foo10', a toplevel procedure
     In procedure call
@@ -433,7 +433,7 @@ Warning: Type mismatch.
 
     (&rest number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:137) 
     In `foo#blabla', a toplevel procedure
     In procedure call
@@ -452,7 +452,7 @@ Warning: Type mismatch.
 
     (&rest number -> number)
 
-Warning: Type mismatch.
+Warning: Deprecated identifier `deprecated-procedure'.
     At toplevel:
     In expression
 
@@ -460,7 +460,7 @@ Warning: Type mismatch.
 
   Use of deprecated `deprecated-procedure'.
 
-Warning: Type mismatch.
+Warning: Deprecated identifier `another-deprecated-procedure'.
     At toplevel:
     In expression
 
@@ -470,7 +470,7 @@ Warning: Type mismatch.
 
   The suggested replacement is `replacement-procedure'.
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:168) 
     At toplevel:
     In procedure call
@@ -489,7 +489,7 @@ Warning: Type mismatch.
 
     ((&rest 'a -> 'b) (list-of 'a) -> 'b)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:169) 
     At toplevel:
     In procedure call
@@ -508,7 +508,7 @@ Warning: Type mismatch.
 
     ((&rest 'a -> 'b) (list-of 'a) -> 'b)
 
-Note: Type mismatch.
+Note: Predicate always true.
     (scrutiny-tests.scm:182) 
     At toplevel:
     In predicate call
@@ -525,7 +525,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests.scm:190) 
     At toplevel:
     In predicate call
@@ -542,7 +542,7 @@ Note: Type mismatch.
 
     (or char string)
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests.scm:191) 
     At toplevel:
     In predicate call
@@ -559,7 +559,7 @@ Note: Type mismatch.
 
     (not (or char string))
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests.scm:194) 
     At toplevel:
     In predicate call
@@ -576,7 +576,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests.scm:195) 
     At toplevel:
     In predicate call
@@ -593,7 +593,7 @@ Note: Type mismatch.
 
     (or char string)
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests.scm:196) 
     At toplevel:
     In predicate call
@@ -610,7 +610,7 @@ Note: Type mismatch.
 
     fixnum
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests.scm:200) 
     At toplevel:
     In predicate call
@@ -627,7 +627,7 @@ Note: Type mismatch.
 
     char
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests.scm:201) 
     At toplevel:
     In predicate call
@@ -644,7 +644,7 @@ Note: Type mismatch.
 
     symbol
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests.scm:205) 
     At toplevel:
     In predicate call
@@ -661,7 +661,7 @@ Note: Type mismatch.
 
     (or char string)
 
-Note: Type mismatch.
+Note: Predicate always false.
     (scrutiny-tests.scm:206) 
     At toplevel:
     In predicate call
@@ -678,7 +678,7 @@ Note: Type mismatch.
 
     symbol
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:210) 
     At toplevel:
     In procedure call
@@ -697,7 +697,7 @@ Warning: Type mismatch.
 
     (pair -> *)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:212) 
     At toplevel:
     In procedure call
@@ -716,7 +716,7 @@ Warning: Type mismatch.
 
     (null -> *)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:214) 
     At toplevel:
     In procedure call
@@ -744,7 +744,7 @@ Warning: In `vector-ref-warn2', a toplevel procedure
 Warning: In `vector-ref-warn3', a toplevel procedure
   (scrutiny-tests.scm:223) in procedure call to `scheme#vector-ref', index 4 
out of range for vector of length 3
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:226) 
     In `vector-ref-standard-warn1', a toplevel procedure
     In procedure call
@@ -772,7 +772,7 @@ Warning: In `vector-set!-warn2', a toplevel procedure
 Warning: In `vector-set!-warn3', a toplevel procedure
   (scrutiny-tests.scm:229) in procedure call to `scheme#vector-set!', index 4 
out of range for vector of length 3
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:232) 
     In `vector-set!-standard-warn1', a toplevel procedure
     In procedure call
@@ -806,7 +806,7 @@ Warning: In `list-ref-warn4', a toplevel procedure
 Warning: In `list-ref-warn5', a toplevel procedure
   (scrutiny-tests.scm:252) in procedure call to `scheme#list-ref', index 4 out 
of range for proper list of length 3
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:281) 
     In `list-ref-standard-warn1', a toplevel procedure
     In procedure call
@@ -825,7 +825,7 @@ Warning: Type mismatch.
 
     ((list-of 'a) fixnum -> 'a)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:282) 
     In `list-ref-standard-warn2', a toplevel procedure
     In procedure call
@@ -844,7 +844,7 @@ Warning: Type mismatch.
 
     ((list-of 'a) fixnum -> 'a)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:284) 
     In `list-ref-standard-warn3', a toplevel procedure
     In procedure call
@@ -863,7 +863,7 @@ Warning: Type mismatch.
 
     ((list-of 'a) fixnum -> 'a)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:285) 
     In `list-ref-standard-warn4', a toplevel procedure
     In procedure call
@@ -882,7 +882,7 @@ Warning: Type mismatch.
 
     ((list-of 'a) fixnum -> 'a)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:289) 
     In `list-ref-type-warn1', a toplevel procedure
     In procedure call
@@ -901,7 +901,7 @@ Warning: Type mismatch.
 
     (number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:291) 
     In `list-ref-type-warn2', a toplevel procedure
     In procedure call
@@ -920,7 +920,7 @@ Warning: Type mismatch.
 
     (number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:295) 
     In `list-ref-type-warn3', a toplevel procedure
     In procedure call
@@ -939,7 +939,7 @@ Warning: Type mismatch.
 
     (number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:307) 
     In `append-result-type-warn1', a toplevel procedure
     In procedure call
@@ -958,7 +958,7 @@ Warning: Type mismatch.
 
     (number -> number)
 
-Warning: Type mismatch.
+Warning: Invalid argument type.
     (scrutiny-tests.scm:312) 
     In `append-result-type-warn2', a toplevel procedure
     In procedure call
diff --git a/tests/specialization.expected b/tests/specialization.expected
index 48afcef..9358803 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -1,5 +1,5 @@
 
-Note: Type mismatch.
+Note: Predicate always true.
     (specialization-tests.scm:3) 
     At toplevel:
     In predicate call
@@ -16,7 +16,7 @@ Note: Type mismatch.
 
     string
 
-Note: Type mismatch.
+Note: Test always true.
     (specialization-tests.scm:3) 
     At toplevel:
     In conditional expression
@@ -27,7 +27,7 @@ Note: Type mismatch.
 
     true
 
-Note: Type mismatch.
+Note: Predicate always false.
     (specialization-tests.scm:4) 
     At toplevel:
     In predicate call
@@ -44,7 +44,7 @@ Note: Type mismatch.
 
     symbol
 
-Note: Type mismatch.
+Note: Test always false.
     (specialization-tests.scm:4) 
     At toplevel:
     In conditional expression
@@ -53,7 +53,7 @@ Note: Type mismatch.
 
   Test condition is always false.
 
-Note: Type mismatch.
+Note: Predicate always true.
     (specialization-tests.scm:10) 
     At toplevel:
     In predicate call
@@ -70,7 +70,7 @@ Note: Type mismatch.
 
     input/output-port
 
-Note: Type mismatch.
+Note: Test always true.
     (specialization-tests.scm:10) 
     At toplevel:
     In conditional expression
@@ -81,7 +81,7 @@ Note: Type mismatch.
 
     true
 
-Note: Type mismatch.
+Note: Predicate always true.
     (specialization-tests.scm:11) 
     At toplevel:
     In predicate call
@@ -98,7 +98,7 @@ Note: Type mismatch.
 
     input/output-port
 
-Note: Type mismatch.
+Note: Test always true.
     (specialization-tests.scm:11) 
     At toplevel:
     In conditional expression
-- 
2.7.4

>From 2d2a20f94d50f0bc5f8935644e86479dbee07565 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 15:40:17 +0200
Subject: [PATCH 03/12] * scrutinizer.scm (scrutinize): Refactor 'pname' to
 toplevel as call-node-pname

The 'pname' is used purely for printing messages, so move it out of
scrutinize.

* scrutinizer.scm (scrutinize): Remove all references to 'pname' from
  the arguments of the report functions.
---
 scrutinizer.scm | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 344b3d1..c4e340b 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -316,8 +316,6 @@
        (and (pair? c) c)))
 
     (define (call-result node args e loc params typeenv)
-      (define (pname)
-       (fragment (first (node-subexpressions node))))
       (let* ((actualtypes (map walked-result args))
             (ptype (car actualtypes))
             (pptype? (procedure-type? ptype))
@@ -334,7 +332,7 @@
               (let-values (((atypes values-rest ok alen)
                             (procedure-argument-types ptype nargs typeenv)))
                 (unless ok
-                  (r-proc-call-argument-count-mismatch loc node (pname) alen 
nargs ptype))
+                  (r-proc-call-argument-count-mismatch loc node alen nargs 
ptype))
                 (do ((actualtypes (cdr actualtypes) (cdr actualtypes))
                      (atypes atypes (cdr atypes))
                      (i 1 (add1 i)))
@@ -344,7 +342,7 @@
                            (car actualtypes)
                            typeenv)
                     (r-proc-call-argument-type-mismatch
-                     loc node (pname) i
+                     loc node i
                      (resolve (car atypes) typeenv)
                      (resolve (car actualtypes) typeenv)
                      ptype)))
@@ -359,7 +357,7 @@
                                   (lambda (pt)
                                     (cond ((match-argument-types (list pt) 
(cdr actualtypes) typeenv)
                                            (r-pred-call-always-true
-                                            loc node (pname) pt (cadr 
actualtypes))
+                                            loc node pt (cadr actualtypes))
                                            (when specialize
                                              (specialize-node!
                                               node (cdr args)
@@ -370,7 +368,7 @@
                                              (trail-restore trail0 typeenv)
                                              (match-argument-types (list `(not 
,pt)) (cdr actualtypes) typeenv))
                                            (r-pred-call-always-false
-                                            loc node (pname) pt (cadr 
actualtypes))
+                                            loc node pt (cadr actualtypes))
                                            (when specialize
                                              (specialize-node!
                                               node (cdr args)
@@ -2515,6 +2513,9 @@
        (sprintf "`~a' from module `~a'" (second r) (first r))
        (sprintf "`~a'" sym))))
 
+(define (call-node-pname node)
+  (fragment (first (node-subexpressions node))))
+
 (define (report2 short report-f location-node-candidates loc msg . args)
   (define (file-location)
     (any (lambda (n) (and (not (string=? "" (node-source-prefix n)))
@@ -2557,7 +2558,8 @@
    (type->pp-string ptype)
    (type->pp-string xptype)))
 
-(define (r-proc-call-argument-count-mismatch loc node pname exp-count argc 
ptype)
+(define (r-proc-call-argument-count-mismatch loc node exp-count argc ptype)
+  (define pname (call-node-pname node))
   (report2
    "Wrong number of arguments"
    warning
@@ -2580,7 +2582,8 @@
    (variable-from-module pname)
    (type->pp-string ptype #f)))
 
-(define (r-proc-call-argument-type-mismatch loc node pname i xptype atype 
ptype)
+(define (r-proc-call-argument-type-mismatch loc node i xptype atype ptype)
+  (define pname (call-node-pname node))
   (report2
    "Invalid argument type"
    warning
@@ -2665,8 +2668,8 @@
         (sprintf "returns ~a values but 1 is expected."
                  (length atype)))))
 
-(define (r-pred-call-always-true loc node pname pred-type atype)
-  ;; pname is "... proc call to predicate `foo' "
+(define (r-pred-call-always-true loc node pred-type atype)
+  (define pname (call-node-pname node))
   (report-notice
    "Predicate always true"
    (list node)
@@ -2690,7 +2693,8 @@
    (type->pp-string pred-type)
    (type->pp-string atype)))
 
-(define (r-pred-call-always-false loc node pname pred-type atype)
+(define (r-pred-call-always-false loc node pred-type atype)
+  (define pname (call-node-pname node))
   (report-notice
    "Predicate always false"
    (list node)
-- 
2.7.4

>From 495e95f4ed785e228060bb70dfdc1b46e1c85785 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 15:59:49 +0200
Subject: [PATCH 04/12] * scrutinizer.scm (r-proc-call-argument-value-count):
 Refactor out describe-expression

---
 scrutinizer.scm | 52 +++++++++++++++++++++++++++++-----------------------
 1 file changed, 29 insertions(+), 23 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index c4e340b..624c830 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2513,6 +2513,34 @@
        (sprintf "`~a' from module `~a'" (second r) (first r))
        (sprintf "`~a'" sym))))
 
+(define (describe-expression node)
+  (define (p-expr n)
+    (sprintf (string-append
+             "This is the expression"
+             "~%~%"
+             "~a")
+            (pp-fragment n)))
+
+  (define (p-node n)
+    (cond
+     ((and (eq? '##core#call (node-class n))
+          (let ((pnode (first (node-subexpressions n))))
+            (and-let* (((eq? '##core#variable (node-class pnode)))
+                       (pname (car (node-parameters pnode)))
+                       (ptype (variable-mark pname '##compiler#type)))
+              (sprintf (string-append
+                        "It is a call to ~a which has this type"
+                        "~%~%"
+                        "~a"
+                        "~%~%"
+                        "~a")
+                       (variable-from-module pname)
+                       (type->pp-string ptype #f)
+                       (p-expr n))))))
+     (else (p-expr n))))
+
+  (p-node node))
+
 (define (call-node-pname node)
   (fragment (first (node-subexpressions node))))
 
@@ -2618,28 +2646,6 @@
     (if (zero? i) ""
        (sprintf " `~a'"
                 (strip-namespace (fragment (first (node-subexpressions 
call-node)))))))
-  (define (p-arg-expr)
-    (define (p-expr)
-      (sprintf (string-append
-               "This is the expression"
-               "~%~%"
-               "~a")
-              (pp-fragment arg-node)))
-    (or (and (eq? '##core#call (node-class arg-node))
-            (let ((pnode (first (node-subexpressions arg-node))))
-              (and-let* (((eq? '##core#variable (node-class pnode)))
-                         (pname (car (node-parameters pnode)))
-                         (ptype (variable-mark pname '##compiler#type)))
-                (sprintf (string-append
-                          "It is a call to ~a which has this type"
-                          "~%~%"
-                          "~a"
-                          "~%~%"
-                          "~a")
-                         (variable-from-module pname)
-                         (type->pp-string ptype #f)
-                         (p-expr)))))
-       (p-expr)))
 
   (define (p short long)
     (report2
@@ -2659,7 +2665,7 @@
      i
      pn
      long
-     (p-arg-expr)))
+     (describe-expression arg-node)))
 
   (if (zero? (length atype))
       (p "No values returned for argument"
-- 
2.7.4

>From 36085adee6af0e47185592a45270c24f8ab485dc Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 16:32:26 +0200
Subject: [PATCH 05/12] * scrutinizer.scm: Add more information to messages

* scrutinizer.scm (describe-expression): Use source-node-tree to get
  the non-mutated AST.

  - Skip the/result node so we can see the call node, if there is one

* scrutinizer.scm (scrutinize): Pass argument node to
  r-invalid-called-procedure-type, r-proc-call-argument-type-mismatch

* scrutinizer.scm (r-invalid-called-procedure-type): Describe the
  invalid procedure expression

* scrutinizer.scm (r-proc-call-argument-type-mismatch): Describe the
  invalid argument expression

* scrutinizer.scm (report2): Flush output so the last printed warning
  gets printed fully right away, and not once the compilation
  finishes, which can take a while on bigger files.

+ update *.expected
---
 scrutinizer.scm                           | 171 ++++++----
 tests/scrutinizer-message-format.expected | 240 +++++++------
 tests/scrutiny-2.expected                 | 132 +++----
 tests/scrutiny.expected                   | 548 +++++++++++++++++++-----------
 tests/specialization.expected             |  38 +--
 5 files changed, 671 insertions(+), 458 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 624c830..6ddc57e 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -326,7 +326,7 @@
        (d "  call: ~a, te: ~a" actualtypes typeenv)
        (cond ((and (not pptype?) (not (match-types xptype ptype typeenv)))
               (r-invalid-called-procedure-type
-               loc node (resolve xptype typeenv) (resolve ptype typeenv))
+               loc node (resolve xptype typeenv) (car args) (resolve ptype 
typeenv))
               (values '* #f))
              (else
               (let-values (((atypes values-rest ok alen)
@@ -335,6 +335,7 @@
                   (r-proc-call-argument-count-mismatch loc node alen nargs 
ptype))
                 (do ((actualtypes (cdr actualtypes) (cdr actualtypes))
                      (atypes atypes (cdr atypes))
+                     (anodes (cdr args) (cdr anodes))
                      (i 1 (add1 i)))
                     ((or (null? actualtypes) (null? atypes)))
                   (unless (match-types 
@@ -344,6 +345,7 @@
                     (r-proc-call-argument-type-mismatch
                      loc node i
                      (resolve (car atypes) typeenv)
+                     (car anodes)
                      (resolve (car actualtypes) typeenv)
                      ptype)))
                 (when (noreturn-procedure-type? ptype)
@@ -2516,7 +2518,7 @@
 (define (describe-expression node)
   (define (p-expr n)
     (sprintf (string-append
-             "This is the expression"
+             "This is the expression:"
              "~%~%"
              "~a")
             (pp-fragment n)))
@@ -2529,7 +2531,7 @@
                        (pname (car (node-parameters pnode)))
                        (ptype (variable-mark pname '##compiler#type)))
               (sprintf (string-append
-                        "It is a call to ~a which has this type"
+                        "The expression is a call to ~a which has this type:"
                         "~%~%"
                         "~a"
                         "~%~%"
@@ -2537,9 +2539,11 @@
                        (variable-from-module pname)
                        (type->pp-string ptype #f)
                        (p-expr n))))))
+     ((eq? '##core#the/result (node-class n)) ; walk through
+      (p-node (first (node-subexpressions n))))
      (else (p-expr n))))
 
-  (p-node node))
+  (p-node (source-node-tree node)))
 
 (define (call-node-pname node)
   (fragment (first (node-subexpressions node))))
@@ -2557,34 +2561,65 @@
        (conc (let ((l (file-location))) (if l (conc l "\n  ") ""))
             (location-name loc "  ")
             (sprintf "~?" msg args))
-       "  ")))))
+       "  ")))
+    ;; Avoid cliffhangers
+    (flush-output)))
 
 (define (report-notice reason location-node-candidates loc msg . args)
   (apply report2 reason ##sys#notice location-node-candidates loc msg args))
 
 ;;; Reports
 
-(define (r-invalid-called-procedure-type loc node xptype ptype)
-  (report2
-   "Invalid procedure"
-   warning
-   (list node)
-   loc
-   (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-invalid-called-procedure-type loc call-node xptype p-node ptype)
+  (define (variable-node-name n)
+    (cond ((eq? '##core#the/result (node-class n))
+          (variable-node-name (first (node-subexpressions n))))
+         ((eq? '##core#variable (node-class n)) (car (node-parameters n)))
+         (else #f)))
+  (if (variable-node-name p-node)
+      (report2
+       "Invalid procedure"
+       warning
+       (list p-node call-node)
+       loc
+       (string-append
+       "In procedure call:"
+       "~%~%"
+       "~a"
+       "~%~%"
+       "Variable ~a is not a procedure."
+       "~%~%"
+       "It has this type:"
+       "~%~%"
+       "~a")
+       (pp-fragment call-node "    ")
+       (variable-from-module (variable-node-name p-node))
+       (type->pp-string ptype))
+      (report2
+       "Invalid procedure"
+       warning
+       (list p-node call-node)
+       loc
+       (string-append
+       "In procedure call:"
+       "~%~%"
+       "~a"
+       "~%~%"
+       "The procedure expression does not appear to be a callable."
+       "~%~%"
+       "The expected type is:"
+       "~%~%"
+       "~a"
+       "~%~%"
+       "The actual type is:"
+       "~%~%"
+       "~a"
+       "~%~%"
+       "~a")
+       (pp-fragment call-node "    ")
+       (type->pp-string xptype)
+       (type->pp-string ptype)
+       (describe-expression p-node))))
 
 (define (r-proc-call-argument-count-mismatch loc node exp-count argc ptype)
   (define pname (call-node-pname node))
@@ -2594,13 +2629,13 @@
    (list node)
    loc
    (string-append
-    "In procedure call"
+    "In procedure call:"
     "~%~%"
     "~a"
     "~%~%"
     "Procedure `~a' is called with ~a argument~a but ~a argument~a is 
expected."
     "~%~%"
-    "Procedure ~a has this type"
+    "Procedure ~a has this type:"
     "~%~%"
     "~a")
    (pp-fragment node "    ")
@@ -2610,7 +2645,7 @@
    (variable-from-module pname)
    (type->pp-string ptype #f)))
 
-(define (r-proc-call-argument-type-mismatch loc node i xptype atype ptype)
+(define (r-proc-call-argument-type-mismatch loc node i xptype arg-node atype 
ptype)
   (define pname (call-node-pname node))
   (report2
    "Invalid argument type"
@@ -2618,19 +2653,21 @@
    (list node)
    loc
    (string-append
-    "In procedure call"
+    "In procedure call:"
     "~%~%"
     "~a"
     "~%~%"
-    "Argument #~a to procedure `~a' has invalid type"
+    "Argument #~a to procedure `~a' has invalid type:"
     "~%~%"
     "~a"
     "~%~%"
-    "The expected type is"
+    "The expected type is:"
+    "~%~%"
+    "~a"
     "~%~%"
     "~a"
     "~%~%"
-    "Procedure ~a has this type"
+    "Procedure ~a has this type:"
     "~%~%"
     "~a")
    (pp-fragment node "    ")
@@ -2638,6 +2675,7 @@
    (strip-namespace pname)
    (type->pp-string atype)
    (type->pp-string xptype)
+   (describe-expression arg-node)
    (variable-from-module pname)
    (type->pp-string ptype #f)))
 
@@ -2654,11 +2692,11 @@
      (list arg-node call-node)
      loc
      (string-append
-      "In procedure call"
+      "In procedure call:"
       "~%~%"
       "~a"
       "~%~%"
-      "Argument #~a to procedure~a ~a"
+      "Argument expression #~a to procedure~a ~a"
       "~%~%"
       "~a")
      (pp-fragment call-node "    ")
@@ -2681,17 +2719,17 @@
    (list node)
    loc
    (string-append
-    "In predicate call"
+    "In predicate call:"
     "~%~%"
     "~a"
     "~%~%"
     "Predicate call will always return true."
     "~%~%"
-    "Procedure ~a is a predicate for"
+    "Procedure ~a is a predicate for:"
     "~%~%"
     "~a"
     "~%~%"
-    "The given argument has this type"
+    "The given argument has this type:"
     "~%~%"
     "~a")
    (pp-fragment node "    ")
@@ -2706,17 +2744,17 @@
    (list node)
    loc
    (string-append
-    "In predicate call"
+    "In predicate call:"
     "~%~%"
     "~a"
     "~%~%"
     "Predicate call will always return false."
     "~%~%"
-    "Procedure ~a is a predicate for"
+    "Procedure ~a is a predicate for:"
     "~%~%"
     "~a"
     "~%~%"
-    "The given argument has this type"
+    "The given argument has this type:"
     "~%~%"
     "~a")
    (pp-fragment node "    ")
@@ -2730,11 +2768,11 @@
    (list test-node if-node)
    loc
    (string-append
-    "In conditional expression"
+    "In conditional expression:"
     "~%~%"
     "~a"
     "~%~%"
-    "Test condition has always true value of type"
+    "Test condition has always true value of type:"
     "~%~%"
     "~a")
    (pp-fragment if-node "    ")
@@ -2746,7 +2784,7 @@
    (list test-node if-node)
    loc
    (string-append
-    "In conditional expression"
+    "In conditional expression:"
     "~%~%"
     "~a"
     "~%~%"
@@ -2761,11 +2799,11 @@
    (list node)
    loc
    (string-append
-    "In expression"
+    "In expression:"
     "~%~%"
     "~a"
     "~%~%"
-    "Expression returns 0 values but is declared to return"
+    "Expression returns 0 values but is declared to return:"
     "~%~%"
     "~a")
    (pp-fragment node "    ")
@@ -2778,42 +2816,42 @@
    (list node)
    loc
    (string-append
-    "In expression"
+    "In expression:"
     "~%~%"
     "~a"
     "~%~%"
     "Expression returns too many values."
     "~%~%"
-    "The expression returns ~a values but is declared to return"
+    "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)
+(define (r-type-mismatch-in-the loc node atype the-type)
   (report2
    "Type mismatch"
    warning
    (list node)
    loc
    (string-append
-    "In expression"
+    "In expression:"
     "~%~%"
     "~a"
     "~%~%"
     "Expression's declared and actual types do not match."
     "~%~%"
-    "The actual type is"
+    "The declared type is:"
     "~%~%"
     "~a"
     "~%~%"
-    "The expression's declared type is"
+    "The actual type is:"
     "~%~%"
     "~a")
    (pp-fragment node "    ")
-   (type->pp-string first-rtype)
-   (type->pp-string the-type)))
+   (type->pp-string the-type)
+   (type->pp-string atype)))
 
 (define (fail-compiler-typecase loc node atype ct-types)
   (define (ppt t) (string-add-indent (type->pp-string t) "  "))
@@ -2822,17 +2860,17 @@
     "No typecase matches.~%"
     "~a"
     "    ~a"
-    "In `compiler-typecase' expression"
+    "In `compiler-typecase' expression:"
     "~%~%"
     "~a"
     "~%~%"
     "  Tested expression in `compiler-typecase' does not match any case."
     "~%~%"
-    "  The expression has this type"
+    "  The expression has this type:"
     "~%~%"
     "~a"
     "~%~%"
-    "  The specified type cases are these"
+    "  The specified type cases are these:"
     "~%~%"
     "~a")
    (if (string=? "" (node-source-prefix node))
@@ -2850,17 +2888,17 @@
    (list a-node node)
    loc
    (string-append
-    "In conditional expression"
+    "In conditional expression:"
     "~%~%"
     "~a"
     "~%~%"
     "The branches have different number of returned values."
     "~%~%"
-    "The true branch returns ~a value~a"
+    "This true branch returns ~a value~a:"
     "~%~%"
     "~a"
     "~%~%"
-    "The false branch returns ~a value~a"
+    "This false branch returns ~a value~a:"
     "~%~%"
     "~a")
    (pp-fragment node "    ")
@@ -2876,23 +2914,24 @@
    (list node value-node)
    loc
    (string-append
-    "In assignment"
+    "In assignment:"
     "~%~%"
     "~a"
     "~%~%"
     "Variable `~a' is assigned invalid value."
     "~%~%"
-    "The assigned value has this type"
+    "The assigned value has this type:"
     "~%~%"
     "~a"
     "~%~%"
-    "The declared type of `~a' is"
+    "The declared type of ~a is:"
     "~%~%"
     "~a")
    (pp-fragment node "    ")
-   var
+   (strip-namespace var)
    (type->pp-string atype)
-   var
+   (variable-from-module (let ((n (real-name var)))
+                          (if (symbol? n) n (string->symbol n))))
    (type->pp-string xptype)))
 
 (define (r-deprecated-identifier loc node id #!optional suggestion)
@@ -2902,7 +2941,7 @@
    (list node)
    loc
    (string-append
-    "In expression"
+    "In expression:"
     "~%~%"
     "~a"
     "~%~%"
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index 1529058..3055712 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -6,147 +6,157 @@ Warning: literal in operator position: (1 2)
 Warning: Wrong number of arguments.
     (test-scrutinizer-message-format.scm:9) 
     In `r-proc-call-argument-count-mismatch', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#cons '())
 
   Procedure `cons' is called with 1 argument but 2 arguments is expected.
 
-  Procedure `cons' from module `scheme' has this type
+  Procedure `cons' from module `scheme' has this type:
 
     ('a 'b --> (pair 'a 'b))
 
 Warning: Invalid argument type.
     (test-scrutinizer-message-format.scm:10) 
     In `r-proc-call-argument-type-mismatch', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#length 'symbol)
 
-  Argument #1 to procedure `length' has invalid type
+  Argument #1 to procedure `length' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     list
 
-  Procedure `length' from module `scheme' has this type
+  This is the expression:
+
+    'symbol
+
+  Procedure `length' from module `scheme' has this type:
 
     (list -> fixnum)
 
 Warning: Too many argument values.
     (test-scrutinizer-message-format.scm:11) 
     In `r-proc-call-argument-value-count', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#list (chicken.time#cpu-time))
 
-  Argument #1 to procedure `list' returns 2 values but 1 is expected.
+  Argument expression #1 to procedure `list' returns 2 values but 1 is 
expected.
 
-  It is a call to `cpu-time' from module `chicken.time' which has this type
+  The expression is a call to `cpu-time' from module `chicken.time' which has 
this type:
 
     (-> fixnum fixnum)
 
-  This is the expression
+  This is the expression:
 
     (chicken.time#cpu-time)
 
 Warning: No values returned for argument.
     (test-scrutinizer-message-format.scm:11) 
     In `r-proc-call-argument-value-count', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#vector (scheme#values))
 
-  Argument #1 to procedure `vector' does not return any values.
+  Argument expression #1 to procedure `vector' does not return any values.
 
-  It is a call to `values' from module `scheme' which has this type
+  The expression is a call to `values' from module `scheme' which has this 
type:
 
     (procedure scheme#values (&rest values) . *)
 
-  This is the expression
+  This is the expression:
 
     (scheme#values)
 
 Warning: Branch value count mismatch.
     (test-scrutinizer-message-format.scm:12) 
     In `r-cond-branch-value-count-mismatch', a toplevel procedure
-    In conditional expression
+    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
+  This true branch returns 1 value:
 
     1
 
-  The false branch returns 2 values
+  This false branch returns 2 values:
 
     (chicken.time#cpu-time)
 
 Warning: Invalid procedure.
     In `r-invalid-called-procedure-type', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (1 2)
 
-  Procedure in a procedure call has invalid type
+  The procedure expression does not appear to be a callable.
+
+  The expected type is:
+
+    (* -> *)
+
+  The actual type is:
 
     fixnum
 
-  The expected type is
+  This is the expression:
 
-    (* -> *)
+    1
 
 Note: Predicate always true.
     (test-scrutinizer-message-format.scm:14) 
     In `r-pred-call-always-true', a toplevel procedure
-    In predicate call
+    In predicate call:
 
       (scheme#list? '())
 
   Predicate call will always return true.
 
-  Procedure `list?' from module `scheme' is a predicate for
+  Procedure `list?' from module `scheme' is a predicate for:
 
     list
 
-  The given argument has this type
+  The given argument has this type:
 
     null
 
 Note: Predicate always false.
     (test-scrutinizer-message-format.scm:15) 
     In `r-pred-call-always-false', a toplevel procedure
-    In predicate call
+    In predicate call:
 
       (scheme#symbol? 1)
 
   Predicate call will always return false.
 
-  Procedure `symbol?' from module `scheme' is a predicate for
+  Procedure `symbol?' from module `scheme' is a predicate for:
 
     symbol
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
 Note: Test always true.
     In `r-cond-test-always-true', a toplevel procedure
-    In conditional expression
+    In conditional expression:
 
       (if 'symbol 1 (##core#undefined))
 
-  Test condition has always true value of type
+  Test condition has always true value of type:
 
     symbol
 
 Note: Test always false.
     In `r-cond-test-always-false', a toplevel procedure
-    In conditional expression
+    In conditional expression:
 
       (if #f 1 (##core#undefined))
 
@@ -154,80 +164,80 @@ Note: Test always false.
 
 Warning: Type mismatch.
     In `r-type-mismatch-in-the', a toplevel procedure
-    In expression
+    In expression:
 
       1
 
   Expression's declared and actual types do not match.
 
-  The actual type is
+  The declared type is:
 
-    fixnum
+    symbol
 
-  The expression's declared type is
+  The actual type is:
 
-    symbol
+    fixnum
 
 Warning: Zero values returned.
     (test-scrutinizer-message-format.scm:19) 
     In `r-zero-values-for-the', a toplevel procedure
-    In expression
+    In expression:
 
       (scheme#values)
 
-  Expression returns 0 values but is declared to return
+  Expression returns 0 values but is declared to return:
 
     symbol
 
 Warning: Too many values returned.
     (test-scrutinizer-message-format.scm:20) 
     In `r-too-many-values-for-the', a toplevel procedure
-    In expression
+    In expression:
 
       (scheme#values 1 2)
 
   Expression returns too many values.
 
-  The expression returns 2 values but is declared to return
+  The expression returns 2 values but is declared to return:
 
     symbol
 
 Warning: Type mismatch.
     (test-scrutinizer-message-format.scm:20) 
     In `r-too-many-values-for-the', a toplevel procedure
-    In expression
+    In expression:
 
       (scheme#values 1 2)
 
   Expression's declared and actual types do not match.
 
-  The actual type is
+  The declared type is:
 
-    fixnum
+    symbol
 
-  The expression's declared type is
+  The actual type is:
 
-    symbol
+    fixnum
 
 Warning: Invalid assigned value type.
     In `r-toplevel-var-assignment-type-mismatch', a toplevel procedure
-    In assignment
+    In assignment:
 
       (set! foo 1)
 
   Variable `foo' is assigned invalid value.
 
-  The assigned value has this type
+  The assigned value has this type:
 
     fixnum
 
-  The declared type of `foo' is
+  The declared type of `foo' is:
 
     boolean
 
 Warning: Deprecated identifier `deprecated-foo'.
     In `r-deprecated-identifier', a toplevel procedure
-    In expression
+    In expression:
 
       deprecated-foo
 
@@ -235,7 +245,7 @@ Warning: Deprecated identifier `deprecated-foo'.
 
 Warning: Deprecated identifier `deprecated-foo2'.
     In `r-deprecated-identifier', a toplevel procedure
-    In expression
+    In expression:
 
       deprecated-foo2
 
@@ -245,17 +255,17 @@ Warning: Deprecated identifier `deprecated-foo2'.
 
 Warning: Invalid assigned value type.
     At toplevel:
-    In assignment
+    In assignment:
 
       (set! foo 1)
 
   Variable `foo' is assigned invalid value.
 
-  The assigned value has this type
+  The assigned value has this type:
 
     fixnum
 
-  The declared type of `foo' is
+  The declared type of `foo' is:
 
     boolean
 
@@ -271,13 +281,13 @@ Warning: Wrong number of arguments.
     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
+    In procedure call:
 
       (scheme#cons '())
 
   Procedure `cons' is called with 1 argument but 2 arguments is expected.
 
-  Procedure `cons' from module `scheme' has this type
+  Procedure `cons' from module `scheme' has this type:
 
     ('a 'b --> (pair 'a 'b))
 
@@ -286,19 +296,23 @@ Warning: Invalid argument type.
     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
+    In procedure call:
 
       (scheme#string-length chicken.base#add1)
 
-  Argument #1 to procedure `string-length' has invalid type
+  Argument #1 to procedure `string-length' has invalid type:
 
     (procedure chicken.base#add1 (number) number)
 
-  The expected type is
+  The expected type is:
 
     string
 
-  Procedure `string-length' from module `scheme' has this type
+  This is the expression:
+
+    chicken.base#add1
+
+  Procedure `string-length' from module `scheme' has this type:
 
     (string -> fixnum)
 
@@ -307,17 +321,17 @@ Warning: Too many argument values.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-proc-call-argument-value-count', a local procedure
-    In procedure call
+    In procedure call:
 
       (scheme#list (chicken.time#cpu-time))
 
-  Argument #1 to procedure `list' returns 2 values but 1 is expected.
+  Argument expression #1 to procedure `list' returns 2 values but 1 is 
expected.
 
-  It is a call to `cpu-time' from module `chicken.time' which has this type
+  The expression is a call to `cpu-time' from module `chicken.time' which has 
this type:
 
     (-> fixnum fixnum)
 
-  This is the expression
+  This is the expression:
 
     (chicken.time#cpu-time)
 
@@ -326,17 +340,17 @@ Warning: No values returned for argument.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-proc-call-argument-value-count', a local procedure
-    In procedure call
+    In procedure call:
 
       (scheme#vector (scheme#values))
 
-  Argument #1 to procedure `vector' does not return any values.
+  Argument expression #1 to procedure `vector' does not return any values.
 
-  It is a call to `values' from module `scheme' which has this type
+  The expression is a call to `values' from module `scheme' which has this 
type:
 
     (procedure scheme#values (&rest values) . *)
 
-  This is the expression
+  This is the expression:
 
     (scheme#values)
 
@@ -345,17 +359,17 @@ Warning: Branch value count mismatch.
     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
+    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
+  This true branch returns 1 value:
 
     1
 
-  The false branch returns 2 values
+  This false branch returns 2 values:
 
     (chicken.time#cpu-time)
 
@@ -365,51 +379,55 @@ Warning: Invalid procedure.
     In `local-bar', a local procedure
     In `r-invalid-called-procedure-type', a local procedure
     In `variable', a local procedure
-    In procedure call
+    In procedure call:
 
       (m#foo2 2)
 
-  Procedure in a procedure call has invalid type
+  Variable `foo2' from module `m' is not a procedure.
 
-    boolean
-
-  The expected type is
+  It has this type:
 
-    (* -> *)
+    boolean
 
 Warning: Invalid procedure.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-invalid-called-procedure-type', a local procedure
     In `non-variable', a local procedure
-    In procedure call
+    In procedure call:
 
       (1 2)
 
-  Procedure in a procedure call has invalid type
+  The procedure expression does not appear to be a callable.
+
+  The expected type is:
+
+    (* -> *)
+
+  The actual type is:
 
     fixnum
 
-  The expected type is
+  This is the expression:
 
-    (* -> *)
+    1
 
 Note: Predicate always true.
     (test-scrutinizer-message-format.scm:52) 
     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
+    In predicate call:
 
       (scheme#list? '())
 
   Predicate call will always return true.
 
-  Procedure `list?' from module `scheme' is a predicate for
+  Procedure `list?' from module `scheme' is a predicate for:
 
     list
 
-  The given argument has this type
+  The given argument has this type:
 
     null
 
@@ -418,17 +436,17 @@ Note: Predicate always false.
     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
+    In predicate call:
 
       (scheme#symbol? 1)
 
   Predicate call will always return false.
 
-  Procedure `symbol?' from module `scheme' is a predicate for
+  Procedure `symbol?' from module `scheme' is a predicate for:
 
     symbol
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
@@ -437,11 +455,11 @@ Note: Test always true.
     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
+    In conditional expression:
 
       (if (scheme#length '()) 1 (##core#undefined))
 
-  Test condition has always true value of type
+  Test condition has always true value of type:
 
     fixnum
 
@@ -449,7 +467,7 @@ Note: Test always false.
     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
+    In conditional expression:
 
       (if #f 1 (##core#undefined))
 
@@ -459,35 +477,35 @@ 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
+    In expression:
 
       1
 
   Expression's declared and actual types do not match.
 
-  The actual type is
+  The declared type is:
 
-    fixnum
+    symbol
 
-  The expression's declared type is
+  The actual type is:
 
-    symbol
+    fixnum
 
 Warning: Invalid assigned value type.
     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
+    In assignment:
 
       (set! m#foo2 1)
 
-  Variable `m#foo2' is assigned invalid value.
+  Variable `foo2' is assigned invalid value.
 
-  The assigned value has this type
+  The assigned value has this type:
 
     fixnum
 
-  The declared type of `m#foo2' is
+  The declared type of `foo2' from module `m' is:
 
     boolean
 
@@ -495,7 +513,7 @@ Warning: Deprecated identifier `deprecated-foo'.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-deprecated-identifier', a local procedure
-    In expression
+    In expression:
 
       m#deprecated-foo
 
@@ -505,7 +523,7 @@ Warning: Deprecated identifier `deprecated-foo2'.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-deprecated-identifier', a local procedure
-    In expression
+    In expression:
 
       m#deprecated-foo2
 
@@ -518,11 +536,11 @@ Warning: Zero values returned.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `r-zero-values-for-the', a local procedure
-    In expression
+    In expression:
 
       (scheme#values)
 
-  Expression returns 0 values but is declared to return
+  Expression returns 0 values but is declared to return:
 
     symbol
 
@@ -546,13 +564,13 @@ Warning: Too many values returned.
     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
+    In expression:
 
       (scheme#values 1 2)
 
   Expression returns too many values.
 
-  The expression returns 2 values but is declared to return
+  The expression returns 2 values but is declared to return:
 
     symbol
 
@@ -561,19 +579,19 @@ Warning: Type mismatch.
     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
+    In expression:
 
       (scheme#values 1 2)
 
   Expression's declared and actual types do not match.
 
-  The actual type is
+  The declared type is:
 
-    fixnum
+    symbol
 
-  The expression's declared type is
+  The actual type is:
 
-    symbol
+    fixnum
 
 Warning: In `m#toplevel-foo', a toplevel procedure
   In `local-bar', a local procedure
@@ -658,17 +676,17 @@ Error: No typecase matches.
     In `m#toplevel-foo', a toplevel procedure
     In `local-bar', a local procedure
     In `fail-compiler-typecase', a local procedure
-    In `compiler-typecase' expression
+    In `compiler-typecase' expression:
 
       (compiler-typecase g104 (symbol 1) (list 2) (else (##core#undefined)))
 
   Tested expression in `compiler-typecase' does not match any case.
 
-  The expression has this type
+  The expression has this type:
 
     fixnum
 
-  The specified type cases are these
+  The specified type cases are these:
 
     symbol
 
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 15bf0a6..cafc076 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -2,373 +2,373 @@
 Note: Predicate always true.
     (scrutiny-tests-2.scm:20) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#pair? p)
 
   Predicate call will always return true.
 
-  Procedure `pair?' from module `scheme' is a predicate for
+  Procedure `pair?' from module `scheme' is a predicate for:
 
     pair
 
-  The given argument has this type
+  The given argument has this type:
 
     pair
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:20) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#pair? l)
 
   Predicate call will always return false.
 
-  Procedure `pair?' from module `scheme' is a predicate for
+  Procedure `pair?' from module `scheme' is a predicate for:
 
     pair
 
-  The given argument has this type
+  The given argument has this type:
 
     null
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:20) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#pair? n)
 
   Predicate call will always return false.
 
-  Procedure `pair?' from module `scheme' is a predicate for
+  Procedure `pair?' from module `scheme' is a predicate for:
 
     pair
 
-  The given argument has this type
+  The given argument has this type:
 
     null
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:20) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#pair? i)
 
   Predicate call will always return false.
 
-  Procedure `pair?' from module `scheme' is a predicate for
+  Procedure `pair?' from module `scheme' is a predicate for:
 
     pair
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:20) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#pair? f)
 
   Predicate call will always return false.
 
-  Procedure `pair?' from module `scheme' is a predicate for
+  Procedure `pair?' from module `scheme' is a predicate for:
 
     pair
 
-  The given argument has this type
+  The given argument has this type:
 
     float
 
 Note: Predicate always true.
     (scrutiny-tests-2.scm:21) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#list? l)
 
   Predicate call will always return true.
 
-  Procedure `list?' from module `scheme' is a predicate for
+  Procedure `list?' from module `scheme' is a predicate for:
 
     list
 
-  The given argument has this type
+  The given argument has this type:
 
     null
 
 Note: Predicate always true.
     (scrutiny-tests-2.scm:21) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#list? n)
 
   Predicate call will always return true.
 
-  Procedure `list?' from module `scheme' is a predicate for
+  Procedure `list?' from module `scheme' is a predicate for:
 
     list
 
-  The given argument has this type
+  The given argument has this type:
 
     null
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:21) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#list? i)
 
   Predicate call will always return false.
 
-  Procedure `list?' from module `scheme' is a predicate for
+  Procedure `list?' from module `scheme' is a predicate for:
 
     list
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:21) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#list? f)
 
   Predicate call will always return false.
 
-  Procedure `list?' from module `scheme' is a predicate for
+  Procedure `list?' from module `scheme' is a predicate for:
 
     list
 
-  The given argument has this type
+  The given argument has this type:
 
     float
 
 Note: Predicate always true.
     (scrutiny-tests-2.scm:22) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#null? n)
 
   Predicate call will always return true.
 
-  Procedure `null?' from module `scheme' is a predicate for
+  Procedure `null?' from module `scheme' is a predicate for:
 
     null
 
-  The given argument has this type
+  The given argument has this type:
 
     null
 
 Note: Predicate always true.
     (scrutiny-tests-2.scm:22) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#null? l)
 
   Predicate call will always return true.
 
-  Procedure `null?' from module `scheme' is a predicate for
+  Procedure `null?' from module `scheme' is a predicate for:
 
     null
 
-  The given argument has this type
+  The given argument has this type:
 
     null
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:22) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#null? p)
 
   Predicate call will always return false.
 
-  Procedure `null?' from module `scheme' is a predicate for
+  Procedure `null?' from module `scheme' is a predicate for:
 
     null
 
-  The given argument has this type
+  The given argument has this type:
 
     pair
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:22) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#null? i)
 
   Predicate call will always return false.
 
-  Procedure `null?' from module `scheme' is a predicate for
+  Procedure `null?' from module `scheme' is a predicate for:
 
     null
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:22) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#null? f)
 
   Predicate call will always return false.
 
-  Procedure `null?' from module `scheme' is a predicate for
+  Procedure `null?' from module `scheme' is a predicate for:
 
     null
 
-  The given argument has this type
+  The given argument has this type:
 
     float
 
 Note: Predicate always true.
     (scrutiny-tests-2.scm:23) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (chicken.base#fixnum? i)
 
   Predicate call will always return true.
 
-  Procedure `fixnum?' from module `chicken.base' is a predicate for
+  Procedure `fixnum?' from module `chicken.base' is a predicate for:
 
     fixnum
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:23) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (chicken.base#fixnum? f)
 
   Predicate call will always return false.
 
-  Procedure `fixnum?' from module `chicken.base' is a predicate for
+  Procedure `fixnum?' from module `chicken.base' is a predicate for:
 
     fixnum
 
-  The given argument has this type
+  The given argument has this type:
 
     float
 
 Note: Predicate always true.
     (scrutiny-tests-2.scm:25) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (chicken.base#flonum? f)
 
   Predicate call will always return true.
 
-  Procedure `flonum?' from module `chicken.base' is a predicate for
+  Procedure `flonum?' from module `chicken.base' is a predicate for:
 
     float
 
-  The given argument has this type
+  The given argument has this type:
 
     float
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:25) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (chicken.base#flonum? i)
 
   Predicate call will always return false.
 
-  Procedure `flonum?' from module `chicken.base' is a predicate for
+  Procedure `flonum?' from module `chicken.base' is a predicate for:
 
     float
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
 Note: Predicate always true.
     (scrutiny-tests-2.scm:27) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#number? i)
 
   Predicate call will always return true.
 
-  Procedure `number?' from module `scheme' is a predicate for
+  Procedure `number?' from module `scheme' is a predicate for:
 
     number
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
 Note: Predicate always true.
     (scrutiny-tests-2.scm:27) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#number? f)
 
   Predicate call will always return true.
 
-  Procedure `number?' from module `scheme' is a predicate for
+  Procedure `number?' from module `scheme' is a predicate for:
 
     number
 
-  The given argument has this type
+  The given argument has this type:
 
     float
 
 Note: Predicate always true.
     (scrutiny-tests-2.scm:27) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#number? u)
 
   Predicate call will always return true.
 
-  Procedure `number?' from module `scheme' is a predicate for
+  Procedure `number?' from module `scheme' is a predicate for:
 
     number
 
-  The given argument has this type
+  The given argument has this type:
 
     number
 
 Note: Predicate always false.
     (scrutiny-tests-2.scm:27) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#number? n)
 
   Predicate call will always return false.
 
-  Procedure `number?' from module `scheme' is a predicate for
+  Procedure `number?' from module `scheme' is a predicate for:
 
     number
 
-  The given argument has this type
+  The given argument has this type:
 
     null
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 9d7b710..8be2fe4 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -5,173 +5,183 @@ Note: Test always true.
     In `a', a toplevel procedure
     In `b', a local procedure
     In `c', a local procedure
-    In conditional expression
+    In conditional expression:
 
       (if x 1 2)
 
-  Test condition has always true value of type
+  Test condition has always true value of type:
 
     number
 
 Note: Test always true.
     In `b', a toplevel procedure
-    In conditional expression
+    In conditional expression:
 
       (if x 1 2)
 
-  Test condition has always true value of type
+  Test condition has always true value of type:
 
     true
 
 Warning: Branch value count mismatch.
     (scrutiny-tests.scm:16) 
     In `foo', a toplevel procedure
-    In conditional expression
+    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
+  This true branch returns 2 values:
 
     (scheme#values 1 2)
 
-  The false branch returns 3 values
+  This false branch returns 3 values:
 
     (scheme#values 1 2 (scheme#+ (scheme#+ (scheme#+ ...))))
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:19) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (bar 3 'a)
 
-  Argument #2 to procedure `bar' has invalid type
+  Argument #2 to procedure `bar' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `bar' has this type
+  This is the expression:
+
+    'a
+
+  Procedure `bar' has this type:
 
     (&rest number -> number)
 
 Warning: Wrong number of arguments.
     (scrutiny-tests.scm:21) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (scheme#string?)
 
   Procedure `string?' is called with 0 arguments but 1 argument is expected.
 
-  Procedure `string?' from module `scheme' has this type
+  Procedure `string?' from module `scheme' has this type:
 
     (* -> boolean)
 
 Warning: Too many argument values.
     (scrutiny-tests.scm:23) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (chicken.base#print (scheme#values 1 2))
 
-  Argument #1 to procedure `print' returns 2 values but 1 is expected.
+  Argument expression #1 to procedure `print' returns 2 values but 1 is 
expected.
 
-  It is a call to `values' from module `scheme' which has this type
+  The expression is a call to `values' from module `scheme' which has this 
type:
 
     (procedure scheme#values (&rest values) . *)
 
-  This is the expression
+  This is the expression:
 
     (scheme#values 1 2)
 
 Warning: No values returned for argument.
     (scrutiny-tests.scm:24) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (chicken.base#print (scheme#values))
 
-  Argument #1 to procedure `print' does not return any values.
+  Argument expression #1 to procedure `print' does not return any values.
 
-  It is a call to `values' from module `scheme' which has this type
+  The expression is a call to `values' from module `scheme' which has this 
type:
 
     (procedure scheme#values (&rest values) . *)
 
-  This is the expression
+  This is the expression:
 
     (scheme#values)
 
 Warning: Invalid procedure.
     (scrutiny-tests.scm:27) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (x)
 
-  Procedure in a procedure call has invalid type
-
-    fixnum
+  Variable `x18' is not a procedure.
 
-  The expected type is
+  It has this type:
 
-    (-> *)
+    fixnum
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:29) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (scheme#+ 'a 'b)
 
-  Argument #1 to procedure `+' has invalid type
+  Argument #1 to procedure `+' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `+' from module `scheme' has this type
+  This is the expression:
+
+    'a
+
+  Procedure `+' from module `scheme' has this type:
 
     (&rest number -> number)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:29) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (scheme#+ 'a 'b)
 
-  Argument #2 to procedure `+' has invalid type
+  Argument #2 to procedure `+' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `+' from module `scheme' has this type
+  This is the expression:
+
+    'b
+
+  Procedure `+' from module `scheme' has this type:
 
     (&rest number -> number)
 
 Warning: Invalid assigned value type.
     At toplevel:
-    In assignment
+    In assignment:
 
       (set! scheme#car 33)
 
-  Variable `scheme#car' is assigned invalid value.
+  Variable `car' is assigned invalid value.
 
-  The assigned value has this type
+  The assigned value has this type:
 
     fixnum
 
-  The declared type of `scheme#car' is
+  The declared type of `car' from module `scheme' is:
 
     (procedure scheme#car ((pair 'a *)) 'a)
 
@@ -180,281 +190,323 @@ Warning: At toplevel:
 
 Warning: Invalid procedure.
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (g19)
 
-  Procedure in a procedure call has invalid type
+  Variable `g1920' is not a procedure.
 
-    fixnum
-
-  The expected type is
+  It has this type:
 
-    (-> *)
+    fixnum
 
 Note: Test always true.
     In `foo', a toplevel procedure
-    In conditional expression
+    In conditional expression:
 
       (if bar 3 (##core#undefined))
 
-  Test condition has always true value of type
+  Test condition has always true value of type:
 
     (procedure bar () *)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:58) 
     In `foo2', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#string-append x "abc")
 
-  Argument #1 to procedure `string-append' has invalid type
+  Argument #1 to procedure `string-append' has invalid type:
 
     number
 
-  The expected type is
+  The expected type is:
 
     string
 
-  Procedure `string-append' from module `scheme' has this type
+  This is the expression:
+
+    x
+
+  Procedure `string-append' from module `scheme' has this type:
 
     (&rest string -> string)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:66) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (foo3 99)
 
-  Argument #1 to procedure `foo3' has invalid type
+  Argument #1 to procedure `foo3' has invalid type:
 
     fixnum
 
-  The expected type is
+  The expected type is:
 
     string
 
-  Procedure `foo3' has this type
+  This is the expression:
+
+    99
+
+  Procedure `foo3' has this type:
 
     (string -> string)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:71) 
     In `foo4', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#+ x 1)
 
-  Argument #1 to procedure `+' has invalid type
+  Argument #1 to procedure `+' has invalid type:
 
     string
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `+' from module `scheme' has this type
+  This is the expression:
+
+    x
+
+  Procedure `+' from module `scheme' has this type:
 
     (&rest number -> number)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:77) 
     In `foo5', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#+ x 3)
 
-  Argument #1 to procedure `+' has invalid type
+  Argument #1 to procedure `+' has invalid type:
 
     string
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `+' from module `scheme' has this type
+  This is the expression:
+
+    x
+
+  Procedure `+' from module `scheme' has this type:
 
     (&rest number -> number)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:83) 
     In `foo6', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#+ x 3)
 
-  Argument #1 to procedure `+' has invalid type
+  Argument #1 to procedure `+' has invalid type:
 
     string
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `+' from module `scheme' has this type
+  This is the expression:
+
+    x
+
+  Procedure `+' from module `scheme' has this type:
 
     (&rest number -> number)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:90) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (scheme#+ x 1)
 
-  Argument #1 to procedure `+' has invalid type
+  Argument #1 to procedure `+' has invalid type:
 
     string
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `+' from module `scheme' has this type
+  This is the expression:
+
+    x
+
+  Procedure `+' from module `scheme' has this type:
 
     (&rest number -> number)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:104) 
     In `foo10', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (foo9 x)
 
-  Argument #1 to procedure `foo9' has invalid type
+  Argument #1 to procedure `foo9' has invalid type:
 
     number
 
-  The expected type is
+  The expected type is:
 
     string
 
-  Procedure `foo9' has this type
+  This is the expression:
+
+    x
+
+  Procedure `foo9' has this type:
 
     (string -> symbol)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:105) 
     In `foo10', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#+ x 1)
 
-  Argument #1 to procedure `+' has invalid type
+  Argument #1 to procedure `+' has invalid type:
 
     string
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `+' from module `scheme' has this type
+  This is the expression:
+
+    x
+
+  Procedure `+' from module `scheme' has this type:
 
     (&rest number -> number)
 
 Warning: Type mismatch.
     (scrutiny-tests.scm:109) 
     In `foo10', a toplevel procedure
-    In expression
+    In expression:
 
       (scheme#substring x 0 10)
 
   Expression's declared and actual types do not match.
 
-  The actual type is
+  The declared type is:
 
-    string
+    pair
 
-  The expression's declared type is
+  The actual type is:
 
-    pair
+    string
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:109) 
     In `foo10', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#string-append (the pair (scheme#substring x 0 10)))
 
-  Argument #1 to procedure `string-append' has invalid type
+  Argument #1 to procedure `string-append' has invalid type:
 
     pair
 
-  The expected type is
+  The expected type is:
 
     string
 
-  Procedure `string-append' from module `scheme' has this type
+  This is the expression:
+
+    (the pair (scheme#substring x 0 10))
+
+  Procedure `string-append' from module `scheme' has this type:
 
     (&rest string -> string)
 
 Warning: Too many values returned.
     (scrutiny-tests.scm:110) 
     In `foo10', a toplevel procedure
-    In expression
+    In expression:
 
       (scheme#values 1 2)
 
   Expression returns too many values.
 
-  The expression returns 2 values but is declared to return
+  The expression returns 2 values but is declared to return:
 
     *
 
 Warning: Zero values returned.
     (scrutiny-tests.scm:111) 
     In `foo10', a toplevel procedure
-    In expression
+    In expression:
 
       (scheme#values)
 
-  Expression returns 0 values but is declared to return
+  Expression returns 0 values but is declared to return:
 
     *
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:112) 
     In `foo10', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#* x y)
 
-  Argument #1 to procedure `*' has invalid type
+  Argument #1 to procedure `*' has invalid type:
 
     string
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `*' from module `scheme' has this type
+  This is the expression:
+
+    x
+
+  Procedure `*' from module `scheme' has this type:
 
     (&rest number -> number)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:137) 
     In `foo#blabla', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#+ 1 'x)
 
-  Argument #2 to procedure `+' has invalid type
+  Argument #2 to procedure `+' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `+' from module `scheme' has this type
+  This is the expression:
+
+    'x
+
+  Procedure `+' from module `scheme' has this type:
 
     (&rest number -> number)
 
 Warning: Deprecated identifier `deprecated-procedure'.
     At toplevel:
-    In expression
+    In expression:
 
       deprecated-procedure
 
@@ -462,7 +514,7 @@ Warning: Deprecated identifier `deprecated-procedure'.
 
 Warning: Deprecated identifier `another-deprecated-procedure'.
     At toplevel:
-    In expression
+    In expression:
 
       another-deprecated-procedure
 
@@ -473,265 +525,305 @@ Warning: Deprecated identifier 
`another-deprecated-procedure'.
 Warning: Invalid argument type.
     (scrutiny-tests.scm:168) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (apply1 scheme#+ (scheme#list 'a 2 3))
 
-  Argument #2 to procedure `apply1' has invalid type
+  Argument #2 to procedure `apply1' has invalid type:
 
     (list symbol fixnum fixnum)
 
-  The expected type is
+  The expected type is:
 
     (list-of number)
 
-  Procedure `apply1' has this type
+  The expression is a call to `list' from module `scheme' which has this type:
+
+    (&rest * -> list)
+
+  This is the expression:
+
+    (scheme#list 'a 2 3)
+
+  Procedure `apply1' has this type:
 
     ((&rest 'a -> 'b) (list-of 'a) -> 'b)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:169) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (apply1 scheme#+ (scheme#cons 'a (scheme#cons 2 (scheme#cons 3 ...))))
 
-  Argument #2 to procedure `apply1' has invalid type
+  Argument #2 to procedure `apply1' has invalid type:
 
     (list symbol fixnum fixnum)
 
-  The expected type is
+  The expected type is:
 
     (list-of number)
 
-  Procedure `apply1' has this type
+  The expression is a call to `cons' from module `scheme' which has this type:
+
+    ('a 'b -> (pair 'a 'b))
+
+  This is the expression:
+
+    (scheme#cons 'a (scheme#cons 2 (scheme#cons 3 '())))
+
+  Procedure `apply1' has this type:
 
     ((&rest 'a -> 'b) (list-of 'a) -> 'b)
 
 Note: Predicate always true.
     (scrutiny-tests.scm:182) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (chicken.base#fixnum? x)
 
   Predicate call will always return true.
 
-  Procedure `fixnum?' from module `chicken.base' is a predicate for
+  Procedure `fixnum?' from module `chicken.base' is a predicate for:
 
     fixnum
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
 Note: Predicate always false.
     (scrutiny-tests.scm:190) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#symbol? x)
 
   Predicate call will always return false.
 
-  Procedure `symbol?' from module `scheme' is a predicate for
+  Procedure `symbol?' from module `scheme' is a predicate for:
 
     symbol
 
-  The given argument has this type
+  The given argument has this type:
 
     (or char string)
 
 Note: Predicate always false.
     (scrutiny-tests.scm:191) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#string? x)
 
   Predicate call will always return false.
 
-  Procedure `string?' from module `scheme' is a predicate for
+  Procedure `string?' from module `scheme' is a predicate for:
 
     string
 
-  The given argument has this type
+  The given argument has this type:
 
     (not (or char string))
 
 Note: Predicate always false.
     (scrutiny-tests.scm:194) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (char-or-string? x)
 
   Predicate call will always return false.
 
-  Procedure `char-or-string?' is a predicate for
+  Procedure `char-or-string?' is a predicate for:
 
     (or char string)
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
 Note: Predicate always false.
     (scrutiny-tests.scm:195) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#symbol? x)
 
   Predicate call will always return false.
 
-  Procedure `symbol?' from module `scheme' is a predicate for
+  Procedure `symbol?' from module `scheme' is a predicate for:
 
     symbol
 
-  The given argument has this type
+  The given argument has this type:
 
     (or char string)
 
 Note: Predicate always false.
     (scrutiny-tests.scm:196) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#string? x)
 
   Predicate call will always return false.
 
-  Procedure `string?' from module `scheme' is a predicate for
+  Procedure `string?' from module `scheme' is a predicate for:
 
     string
 
-  The given argument has this type
+  The given argument has this type:
 
     fixnum
 
 Note: Predicate always false.
     (scrutiny-tests.scm:200) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#symbol? x)
 
   Predicate call will always return false.
 
-  Procedure `symbol?' from module `scheme' is a predicate for
+  Procedure `symbol?' from module `scheme' is a predicate for:
 
     symbol
 
-  The given argument has this type
+  The given argument has this type:
 
     char
 
 Note: Predicate always false.
     (scrutiny-tests.scm:201) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#string? x)
 
   Predicate call will always return false.
 
-  Procedure `string?' from module `scheme' is a predicate for
+  Procedure `string?' from module `scheme' is a predicate for:
 
     string
 
-  The given argument has this type
+  The given argument has this type:
 
     symbol
 
 Note: Predicate always false.
     (scrutiny-tests.scm:205) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#symbol? x)
 
   Predicate call will always return false.
 
-  Procedure `symbol?' from module `scheme' is a predicate for
+  Procedure `symbol?' from module `scheme' is a predicate for:
 
     symbol
 
-  The given argument has this type
+  The given argument has this type:
 
     (or char string)
 
 Note: Predicate always false.
     (scrutiny-tests.scm:206) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#string? x)
 
   Predicate call will always return false.
 
-  Procedure `string?' from module `scheme' is a predicate for
+  Procedure `string?' from module `scheme' is a predicate for:
 
     string
 
-  The given argument has this type
+  The given argument has this type:
 
     symbol
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:210) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (f (scheme#list))
 
-  Argument #1 to procedure `f' has invalid type
+  Argument #1 to procedure `f' has invalid type:
 
     null
 
-  The expected type is
+  The expected type is:
 
     pair
 
-  Procedure `f' has this type
+  The expression is a call to `list' from module `scheme' which has this type:
+
+    (&rest * -> list)
+
+  This is the expression:
+
+    (scheme#list)
+
+  Procedure `f' has this type:
 
     (pair -> *)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:212) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (f (scheme#list 1))
 
-  Argument #1 to procedure `f' has invalid type
+  Argument #1 to procedure `f' has invalid type:
 
     (list fixnum)
 
-  The expected type is
+  The expected type is:
 
     null
 
-  Procedure `f' has this type
+  The expression is a call to `list' from module `scheme' which has this type:
+
+    (&rest * -> list)
+
+  This is the expression:
+
+    (scheme#list 1)
+
+  Procedure `f' has this type:
 
     (null -> *)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:214) 
     At toplevel:
-    In procedure call
+    In procedure call:
 
       (f (scheme#cons 1 2))
 
-  Argument #1 to procedure `f' has invalid type
+  Argument #1 to procedure `f' has invalid type:
 
     (pair fixnum fixnum)
 
-  The expected type is
+  The expected type is:
 
     list
 
-  Procedure `f' has this type
+  The expression is a call to `cons' from module `scheme' which has this type:
+
+    ('a 'b -> (pair 'a 'b))
+
+  This is the expression:
+
+    (scheme#cons 1 2)
+
+  Procedure `f' has this type:
 
     (list -> *)
 
@@ -747,19 +839,23 @@ Warning: In `vector-ref-warn3', a toplevel procedure
 Warning: Invalid argument type.
     (scrutiny-tests.scm:226) 
     In `vector-ref-standard-warn1', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#vector-ref v1 'bad)
 
-  Argument #2 to procedure `vector-ref' has invalid type
+  Argument #2 to procedure `vector-ref' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     fixnum
 
-  Procedure `vector-ref' from module `scheme' has this type
+  This is the expression:
+
+    'bad
+
+  Procedure `vector-ref' from module `scheme' has this type:
 
     ((vector-of 'a) fixnum -> 'a)
 
@@ -775,19 +871,23 @@ Warning: In `vector-set!-warn3', a toplevel procedure
 Warning: Invalid argument type.
     (scrutiny-tests.scm:232) 
     In `vector-set!-standard-warn1', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#vector-set! v1 'bad 'whatever)
 
-  Argument #2 to procedure `vector-set!' has invalid type
+  Argument #2 to procedure `vector-set!' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     fixnum
 
-  Procedure `vector-set!' from module `scheme' has this type
+  This is the expression:
+
+    'bad
+
+  Procedure `vector-set!' from module `scheme' has this type:
 
     (vector fixnum * -> undefined)
 
@@ -809,171 +909,227 @@ Warning: In `list-ref-warn5', a toplevel procedure
 Warning: Invalid argument type.
     (scrutiny-tests.scm:281) 
     In `list-ref-standard-warn1', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#list-ref l1 'bad)
 
-  Argument #2 to procedure `list-ref' has invalid type
+  Argument #2 to procedure `list-ref' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     fixnum
 
-  Procedure `list-ref' from module `scheme' has this type
+  This is the expression:
+
+    'bad
+
+  Procedure `list-ref' from module `scheme' has this type:
 
     ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:282) 
     In `list-ref-standard-warn2', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#list-ref l1 'bad)
 
-  Argument #2 to procedure `list-ref' has invalid type
+  Argument #2 to procedure `list-ref' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     fixnum
 
-  Procedure `list-ref' from module `scheme' has this type
+  This is the expression:
+
+    'bad
+
+  Procedure `list-ref' from module `scheme' has this type:
 
     ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:284) 
     In `list-ref-standard-warn3', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#list-ref l2 'bad)
 
-  Argument #2 to procedure `list-ref' has invalid type
+  Argument #2 to procedure `list-ref' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     fixnum
 
-  Procedure `list-ref' from module `scheme' has this type
+  This is the expression:
+
+    'bad
+
+  Procedure `list-ref' from module `scheme' has this type:
 
     ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:285) 
     In `list-ref-standard-warn4', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (scheme#list-ref l2 'bad)
 
-  Argument #2 to procedure `list-ref' has invalid type
+  Argument #2 to procedure `list-ref' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     fixnum
 
-  Procedure `list-ref' from module `scheme' has this type
+  This is the expression:
+
+    'bad
+
+  Procedure `list-ref' from module `scheme' has this type:
 
     ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:289) 
     In `list-ref-type-warn1', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (chicken.base#add1 (scheme#list-ref l1 1))
 
-  Argument #1 to procedure `add1' has invalid type
+  Argument #1 to procedure `add1' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `add1' from module `chicken.base' has this type
+  The expression is a call to `list-ref' from module `scheme' which has this 
type:
+
+    ((list-of 'a) fixnum -> 'a)
+
+  This is the expression:
+
+    (scheme#list-ref l1 1)
+
+  Procedure `add1' from module `chicken.base' has this type:
 
     (number -> number)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:291) 
     In `list-ref-type-warn2', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (chicken.base#add1 (scheme#list-ref l2 1))
 
-  Argument #1 to procedure `add1' has invalid type
+  Argument #1 to procedure `add1' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `add1' from module `chicken.base' has this type
+  The expression is a call to `list-ref' from module `scheme' which has this 
type:
+
+    ((list-of 'a) fixnum -> 'a)
+
+  This is the expression:
+
+    (scheme#list-ref l2 1)
+
+  Procedure `add1' from module `chicken.base' has this type:
 
     (number -> number)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:295) 
     In `list-ref-type-warn3', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (chicken.base#add1 (scheme#list-ref l3 1))
 
-  Argument #1 to procedure `add1' has invalid type
+  Argument #1 to procedure `add1' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `add1' from module `chicken.base' has this type
+  The expression is a call to `list-ref' from module `scheme' which has this 
type:
+
+    ((list-of 'a) fixnum -> 'a)
+
+  This is the expression:
+
+    (scheme#list-ref l3 1)
+
+  Procedure `add1' from module `chicken.base' has this type:
 
     (number -> number)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:307) 
     In `append-result-type-warn1', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (chicken.base#add1 (scheme#list-ref l1 1))
 
-  Argument #1 to procedure `add1' has invalid type
+  Argument #1 to procedure `add1' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `add1' from module `chicken.base' has this type
+  The expression is a call to `list-ref' from module `scheme' which has this 
type:
+
+    ((list-of 'a) fixnum -> 'a)
+
+  This is the expression:
+
+    (scheme#list-ref l1 1)
+
+  Procedure `add1' from module `chicken.base' has this type:
 
     (number -> number)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:312) 
     In `append-result-type-warn2', a toplevel procedure
-    In procedure call
+    In procedure call:
 
       (chicken.base#add1 (scheme#list-ref l3 3))
 
-  Argument #1 to procedure `add1' has invalid type
+  Argument #1 to procedure `add1' has invalid type:
 
     symbol
 
-  The expected type is
+  The expected type is:
 
     number
 
-  Procedure `add1' from module `chicken.base' has this type
+  The expression is a call to `list-ref' from module `scheme' which has this 
type:
+
+    ((list-of 'a) fixnum -> 'a)
+
+  This is the expression:
+
+    (scheme#list-ref l3 3)
+
+  Procedure `add1' from module `chicken.base' has this type:
 
     (number -> number)
 
diff --git a/tests/specialization.expected b/tests/specialization.expected
index 9358803..a2587f1 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -2,52 +2,52 @@
 Note: Predicate always true.
     (specialization-tests.scm:3) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#string? a)
 
   Predicate call will always return true.
 
-  Procedure `string?' from module `scheme' is a predicate for
+  Procedure `string?' from module `scheme' is a predicate for:
 
     string
 
-  The given argument has this type
+  The given argument has this type:
 
     string
 
 Note: Test always true.
     (specialization-tests.scm:3) 
     At toplevel:
-    In conditional expression
+    In conditional expression:
 
       (if (scheme#string? a) 'ok 'no)
 
-  Test condition has always true value of type
+  Test condition has always true value of type:
 
     true
 
 Note: Predicate always false.
     (specialization-tests.scm:4) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#string? a)
 
   Predicate call will always return false.
 
-  Procedure `string?' from module `scheme' is a predicate for
+  Procedure `string?' from module `scheme' is a predicate for:
 
     string
 
-  The given argument has this type
+  The given argument has this type:
 
     symbol
 
 Note: Test always false.
     (specialization-tests.scm:4) 
     At toplevel:
-    In conditional expression
+    In conditional expression:
 
       (if (scheme#string? a) 'ok 'no)
 
@@ -56,55 +56,55 @@ Note: Test always false.
 Note: Predicate always true.
     (specialization-tests.scm:10) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#input-port? p)
 
   Predicate call will always return true.
 
-  Procedure `input-port?' from module `scheme' is a predicate for
+  Procedure `input-port?' from module `scheme' is a predicate for:
 
     input-port
 
-  The given argument has this type
+  The given argument has this type:
 
     input/output-port
 
 Note: Test always true.
     (specialization-tests.scm:10) 
     At toplevel:
-    In conditional expression
+    In conditional expression:
 
       (if (scheme#input-port? p) 'ok 'no)
 
-  Test condition has always true value of type
+  Test condition has always true value of type:
 
     true
 
 Note: Predicate always true.
     (specialization-tests.scm:11) 
     At toplevel:
-    In predicate call
+    In predicate call:
 
       (scheme#output-port? p)
 
   Predicate call will always return true.
 
-  Procedure `output-port?' from module `scheme' is a predicate for
+  Procedure `output-port?' from module `scheme' is a predicate for:
 
     output-port
 
-  The given argument has this type
+  The given argument has this type:
 
     input/output-port
 
 Note: Test always true.
     (specialization-tests.scm:11) 
     At toplevel:
-    In conditional expression
+    In conditional expression:
 
       (if (scheme#output-port? p) 'ok 'no)
 
-  Test condition has always true value of type
+  Test condition has always true value of type:
 
     true
-- 
2.7.4

>From 5df2d84aff91552f85c762825a4a969671b29f33 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 16:52:56 +0200
Subject: [PATCH 06/12] * scrutinizer.scm: Pretty print messages from special
 cases

* scrutinizer.scm (r-index-out-of-range) : New function

+ update *.expected
---
 scrutinizer.scm                           |  79 ++++++++-------------
 tests/scrutinizer-message-format.expected | 100 ++++++++++++++++++++-------
 tests/scrutiny.expected                   | 110 ++++++++++++++++++++++++------
 3 files changed, 191 insertions(+), 98 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 6ddc57e..dcc6d3c 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2076,16 +2076,6 @@
        rtypes)))
 
 (let ()
-  ;; TODO: Complain argument not available here, so we can't use the
-  ;; standard "report" defined above.  However, ##sys#enable-warnings
-  ;; and "complain" (do-scrutinize) are always true together, except
-  ;; that "complain" will be false while ##sys#enable-warnings is true
-  ;; on "no-usual-integrations", so perhaps get rid of "complain"?
-  (define (report loc msg . args)
-    (warning
-     (conc (location-name loc)
-          (sprintf "~?" msg args))))
-
   (define (known-length-vector-index node args loc expected-argcount)
     (and-let* ((subs (node-subexpressions node))
               ((= (length subs) (add1 expected-argcount)))
@@ -2100,12 +2090,7 @@
       (if (and (>= val 0) (< val vector-length))
          val
          (begin
-           (report
-            loc "~ain procedure call to `~a', index ~a out of range \
-                   for vector of length ~a"
-            (node-source-prefix node)
-            ;; TODO: It might make more sense to use "pname" here
-            (first (node-parameters (first subs))) val vector-length)
+           (r-index-out-of-range loc node val vector-length "vector")
            #f))))
 
   ;; These are a bit hacky, since they mutate the node.  These special
@@ -2145,12 +2130,6 @@
 ;   list-ref, list-tail
 
 (let ()
-  ;; See comment in vector (let) just above this
-  (define (report loc msg . args)
-    (warning
-     (conc (location-name loc)
-          (sprintf "~?" msg args))))
-
   (define (list-or-null a)
     (if (null? a) 'null `(list ,@a)))
 
@@ -2193,25 +2172,15 @@
                     ((eq? 'quote (node-class index)))
                     (val (first (node-parameters index)))
                     ((fixnum? val))) ; Standard type warning otherwise
-           ;; TODO: It might make sense to use "pname" when reporting
            (cond ((negative? val)
-                  ;; Negative indices should always generate a warning
-                  (report
-                   loc "~ain procedure call to `~a', index ~a is \
-                        negative, which is never valid"
-                   (node-source-prefix node)
-                   (first (node-parameters (first subs))) val)
+                  (r-index-out-of-range loc node val 'not-used "list")
                   #f)
                  ((split-list-type arg1 val k))
                  ;; Warn only if it's a known proper list.  This avoids
                  ;; false warnings due to component smashing.
                  ((proper-list-type-length arg1) =>
                   (lambda (length)
-                    (report
-                     loc "~ain procedure call to `~a', index ~a out of \
-                        range for proper list of length ~a"
-                     (node-source-prefix node)
-                     (first (node-parameters (first subs))) val length)
+                    (r-index-out-of-range loc node val length "list")
                     #f))
                  (else #f)))
          rtypes)))
@@ -2257,12 +2226,6 @@
        rtypes)))
 
 (let ()
-  ;; See comment in vector (let)
-  (define (report loc msg . args)
-    (warning
-     (conc (location-name loc)
-          (sprintf "~?" msg args))))
-
   (define (append-special-case node args loc rtypes)
     (define (potentially-proper-list? l) (match-types l 'list '()))
 
@@ -2294,17 +2257,9 @@
                ;; The final argument may be an atom or improper list
                (unless (or (null? (cdr arg-types))
                            (potentially-proper-list? arg1))
-                 (report
-                  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
-                  (type->pp-string arg1)))
+                 (r-proc-call-argument-type-mismatch
+                  loc node index 'list
+                  (car arg-types) arg1 (variable-mark 'scheme#append 
'##compiler#type)))
                #f))))))
     (cond ((derive-result-type) => list)
          (else rtypes)))
@@ -2762,6 +2717,28 @@
    (type->pp-string pred-type)
    (type->pp-string atype)))
 
+(define (r-index-out-of-range loc node idx obj-length obj-name)
+  ;; Negative indices should always generate a warning
+  (define pname (call-node-pname node))
+  (report2
+   (sprintf "~a~a index ~a"
+           (char-upcase (string-ref obj-name 0)) (substring obj-name 1)
+           (if (negative? idx) "negative" "out of range"))
+   warning
+   (list node)
+   loc
+   (string-append
+    "In procedure call:"
+    "~%~%"
+    "~a"
+    "~%~%"
+    "Calling ~a with ~a")
+   (pp-fragment node "    ")
+   (variable-from-module pname)
+   (if (negative? idx)
+       (sprintf "a negative index ~a." idx)
+       (sprintf "index `~a' for a ~a of length `~a'." idx obj-name 
obj-length))))
+
 (define (r-cond-test-always-true loc if-node test-node t)
   (report-notice
    "Test always true"
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index 3055712..993912a 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -269,12 +269,28 @@ Warning: Invalid assigned value type.
 
     boolean
 
-Warning: In `append-invalid-arg', a toplevel procedure
-  (test-scrutinizer-message-format.scm:26) in procedure call to 
`scheme#append', argument #1 is of type
+Warning: Invalid argument type.
+    (test-scrutinizer-message-format.scm:26) 
+    In `append-invalid-arg', a toplevel procedure
+    In procedure call:
+
+      (scheme#append 1 (scheme#list 1))
+
+  Argument #1 to procedure `append' has invalid type:
+
+    fixnum
+
+  The expected type is:
+
+    list
+
+  This is the expression:
+
+    1
 
-  fixnum
+  Procedure `append' from module `scheme' has this type:
 
-  but expected a proper list.
+    (&rest * -> *)
 
 Warning: Wrong number of arguments.
     (test-scrutinizer-message-format.scm:45) 
@@ -644,32 +660,66 @@ Warning: In `m#toplevel-foo', a toplevel procedure
   In `too-many-values-for-assignment', a local procedure
   expected a single result in assignment to `m#foo', but received 2 results
 
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `append-invalid-arg', a local procedure
-  (test-scrutinizer-message-format.scm:80) in procedure call to 
`scheme#append', argument #1 is of type
+Warning: Invalid argument type.
+    (test-scrutinizer-message-format.scm:80) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `append-invalid-arg', a local procedure
+    In procedure call:
 
-  fixnum
+      (scheme#append 1 (scheme#list 1))
 
-  but expected a proper list.
+  Argument #1 to procedure `append' has invalid type:
 
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `vector-list-out-of-range', a local procedure
-  In `list-ref-negative-index', a local procedure
-  (test-scrutinizer-message-format.scm:82) in procedure call to 
`scheme#list-ref', index -1 is negative, which is never valid
+    fixnum
 
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `vector-list-out-of-range', a local procedure
-  In `list-ref-out-of-range', a local procedure
-  (test-scrutinizer-message-format.scm:83) in procedure call to 
`scheme#list-ref', index 1 out of range for proper list of length 0
+  The expected type is:
 
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `vector-list-out-of-range', a local procedure
-  In `vector-ref-out-of-range', a local procedure
-  (test-scrutinizer-message-format.scm:84) in procedure call to 
`scheme#vector-ref', index -1 out of range for vector of length 0
+    list
+
+  This is the expression:
+
+    1
+
+  Procedure `append' from module `scheme' has this type:
+
+    (&rest * -> *)
+
+Warning: List index negative.
+    (test-scrutinizer-message-format.scm:82) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `vector-list-out-of-range', a local procedure
+    In `list-ref-negative-index', a local procedure
+    In procedure call:
+
+      (scheme#list-ref '() -1)
+
+  Calling `list-ref' from module `scheme' with a negative index -1.
+
+Warning: List index out of range.
+    (test-scrutinizer-message-format.scm:83) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `vector-list-out-of-range', a local procedure
+    In `list-ref-out-of-range', a local procedure
+    In procedure call:
+
+      (scheme#list-ref '() 1)
+
+  Calling `list-ref' from module `scheme' with index `1' for a list of length 
`0'.
+
+Warning: Vector index negative.
+    (test-scrutinizer-message-format.scm:84) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `vector-list-out-of-range', a local procedure
+    In `vector-ref-out-of-range', a local procedure
+    In procedure call:
+
+      (scheme#vector-ref (scheme#vector) -1)
+
+  Calling `vector-ref' from module `scheme' with a negative index -1.
 
 Error: No typecase matches.
     (test-scrutinizer-message-format.scm:86) 
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 8be2fe4..2c27951 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -827,14 +827,32 @@ Warning: Invalid argument type.
 
     (list -> *)
 
-Warning: In `vector-ref-warn1', a toplevel procedure
-  (scrutiny-tests.scm:220) in procedure call to `scheme#vector-ref', index -1 
out of range for vector of length 3
+Warning: Vector index negative.
+    (scrutiny-tests.scm:220) 
+    In `vector-ref-warn1', a toplevel procedure
+    In procedure call:
+
+      (scheme#vector-ref v1 -1)
+
+  Calling `vector-ref' from module `scheme' with a negative index -1.
+
+Warning: Vector index out of range.
+    (scrutiny-tests.scm:222) 
+    In `vector-ref-warn2', a toplevel procedure
+    In procedure call:
+
+      (scheme#vector-ref v1 3)
+
+  Calling `vector-ref' from module `scheme' with index `3' for a vector of 
length `3'.
+
+Warning: Vector index out of range.
+    (scrutiny-tests.scm:223) 
+    In `vector-ref-warn3', a toplevel procedure
+    In procedure call:
 
-Warning: In `vector-ref-warn2', a toplevel procedure
-  (scrutiny-tests.scm:222) in procedure call to `scheme#vector-ref', index 3 
out of range for vector of length 3
+      (scheme#vector-ref v1 4)
 
-Warning: In `vector-ref-warn3', a toplevel procedure
-  (scrutiny-tests.scm:223) in procedure call to `scheme#vector-ref', index 4 
out of range for vector of length 3
+  Calling `vector-ref' from module `scheme' with index `4' for a vector of 
length `3'.
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:226) 
@@ -859,14 +877,32 @@ Warning: Invalid argument type.
 
     ((vector-of 'a) fixnum -> 'a)
 
-Warning: In `vector-set!-warn1', a toplevel procedure
-  (scrutiny-tests.scm:227) in procedure call to `scheme#vector-set!', index -1 
out of range for vector of length 3
+Warning: Vector index negative.
+    (scrutiny-tests.scm:227) 
+    In `vector-set!-warn1', a toplevel procedure
+    In procedure call:
+
+      (scheme#vector-set! v1 -1 'whatever)
+
+  Calling `vector-set!' from module `scheme' with a negative index -1.
+
+Warning: Vector index out of range.
+    (scrutiny-tests.scm:228) 
+    In `vector-set!-warn2', a toplevel procedure
+    In procedure call:
+
+      (scheme#vector-set! v1 3 'whatever)
 
-Warning: In `vector-set!-warn2', a toplevel procedure
-  (scrutiny-tests.scm:228) in procedure call to `scheme#vector-set!', index 3 
out of range for vector of length 3
+  Calling `vector-set!' from module `scheme' with index `3' for a vector of 
length `3'.
+
+Warning: Vector index out of range.
+    (scrutiny-tests.scm:229) 
+    In `vector-set!-warn3', a toplevel procedure
+    In procedure call:
 
-Warning: In `vector-set!-warn3', a toplevel procedure
-  (scrutiny-tests.scm:229) in procedure call to `scheme#vector-set!', index 4 
out of range for vector of length 3
+      (scheme#vector-set! v1 4 'whatever)
+
+  Calling `vector-set!' from module `scheme' with index `4' for a vector of 
length `3'.
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:232) 
@@ -891,20 +927,50 @@ Warning: Invalid argument type.
 
     (vector fixnum * -> undefined)
 
-Warning: In `list-ref-warn1', a toplevel procedure
-  (scrutiny-tests.scm:238) in procedure call to `scheme#list-ref', index -1 is 
negative, which is never valid
+Warning: List index negative.
+    (scrutiny-tests.scm:238) 
+    In `list-ref-warn1', a toplevel procedure
+    In procedure call:
+
+      (scheme#list-ref l1 -1)
+
+  Calling `list-ref' from module `scheme' with a negative index -1.
+
+Warning: List index negative.
+    (scrutiny-tests.scm:241) 
+    In `list-ref-warn2', a toplevel procedure
+    In procedure call:
+
+      (scheme#list-ref l2 -1)
+
+  Calling `list-ref' from module `scheme' with a negative index -1.
 
-Warning: In `list-ref-warn2', a toplevel procedure
-  (scrutiny-tests.scm:241) in procedure call to `scheme#list-ref', index -1 is 
negative, which is never valid
+Warning: List index negative.
+    (scrutiny-tests.scm:244) 
+    In `list-ref-warn3', a toplevel procedure
+    In procedure call:
+
+      (scheme#list-ref l3 -1)
+
+  Calling `list-ref' from module `scheme' with a negative index -1.
+
+Warning: List index out of range.
+    (scrutiny-tests.scm:246) 
+    In `list-ref-warn4', a toplevel procedure
+    In procedure call:
+
+      (scheme#list-ref l1 3)
 
-Warning: In `list-ref-warn3', a toplevel procedure
-  (scrutiny-tests.scm:244) in procedure call to `scheme#list-ref', index -1 is 
negative, which is never valid
+  Calling `list-ref' from module `scheme' with index `3' for a list of length 
`3'.
+
+Warning: List index out of range.
+    (scrutiny-tests.scm:252) 
+    In `list-ref-warn5', a toplevel procedure
+    In procedure call:
 
-Warning: In `list-ref-warn4', a toplevel procedure
-  (scrutiny-tests.scm:246) in procedure call to `scheme#list-ref', index 3 out 
of range for proper list of length 3
+      (scheme#list-ref l1 4)
 
-Warning: In `list-ref-warn5', a toplevel procedure
-  (scrutiny-tests.scm:252) in procedure call to `scheme#list-ref', index 4 out 
of range for proper list of length 3
+  Calling `list-ref' from module `scheme' with index `4' for a list of length 
`3'.
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:281) 
-- 
2.7.4

>From 1450eb18f9beef12877639eda54f9374a34eb90a Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Wed, 28 Nov 2018 10:48:43 +0200
Subject: [PATCH 07/12] * scrutinizer.scm: Pretty print value count mismatches
 for let,set!,if

* scrutinizer.scm (scrutinize): remove old single and rename single2 -> single
  - call new functions

* scrutinizer.scm (r-conditional-value-count-invalid) : New function
* scrutinizer.scm (r-let-value-count-invalid) : New function
* scrutinizer.scm (r-assignment-value-count-invalid) : New function

+ update *.expected
---
 scrutinizer.scm                           | 105 +++++++----
 tests/scrutinizer-message-format.expected | 292 +++++++++++++++++++++++-------
 tests/scrutiny.expected                   |  18 +-
 3 files changed, 320 insertions(+), 95 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index dcc6d3c..a443215 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -277,25 +277,7 @@
        (d "assignment to var ~a in ~a is always immediate" var loc)
        #t))
 
-    (define (single node what tv loc)
-      (if (eq? '* tv)
-         '*
-         (let ((n (length tv)))
-           (cond ((= 1 n) (car tv))
-                 ((zero? n)
-                  (report
-                   loc
-                   "~aexpected a single result ~a, but received zero results"
-                   (node-source-prefix node) what)
-                  'undefined)
-                 (else
-                  (report
-                   loc
-                   "~aexpected a single result ~a, but received ~a result~a"
-                   (node-source-prefix node) what n (multiples n))
-                  (first tv))))))
-
-    (define (single2 tv r-value-count-mismatch)
+    (define (single tv r-value-count-mismatch)
       (if (eq? '* tv)
          '*
          (let ((n (length tv)))
@@ -465,7 +447,8 @@
                        (tst (first subs))
                        (nor-1 noreturn))
                    (set! noreturn #f)
-                   (let* ((rt (single n "in conditional" (walk tst e loc #f #f 
flow tags) loc))
+                   (let* ((rt (single (walk tst e loc #f #f flow tags)
+                                      (cut r-conditional-value-count-invalid 
loc n tst <>)))
                           (c (second subs))
                           (a (third subs))
                           (nor0 noreturn))
@@ -518,11 +501,8 @@
                        (walk (car body) (append e2 e) loc dest tail flow ctags)
                        (let* ((var (car vars))
                               (val (car body))
-                              (t (single
-                                  n
-                                  (sprintf "in `let' binding of `~a'" 
(real-name var))
-                                  (walk val e loc var #f flow #f) 
-                                  loc)))
+                              (t (single (walk val e loc var #f flow #f)
+                                         (cut r-let-value-count-invalid loc 
var n val <>))))
                          (when (and (eq? (node-class val) '##core#variable)
                                     (not (db-get db var 'assigned)))
                            (let ((var2 (first (node-parameters val))))
@@ -586,11 +566,9 @@
                 ((set! ##core#set!)
                  (let* ((var (first params))
                         (type (variable-mark var '##compiler#type))
-                        (rt (single
-                             n
-                             (sprintf "in assignment to `~a'" var)
-                             (walk (first subs) e loc var #f flow #f)
-                             loc))
+                        (rt (single (walk (first subs) e loc var #f flow #f)
+                                    (cut r-assignment-value-count-invalid
+                                         loc var n (first subs) <>)))
                         (typeenv (append 
                                   (if type (type-typeenv type) '())
                                   (type-typeenv rt)))
@@ -663,7 +641,7 @@
                                      (make-node
                                       '##core#the/result
                                       (list
-                                       (single2
+                                       (single
                                         (walk n2 e loc #f #f flow #f)
                                         (cut r-proc-call-argument-value-count 
loc n i n2 <>)))
                                       (list n2)))
@@ -2667,6 +2645,71 @@
         (sprintf "returns ~a values but 1 is expected."
                  (length atype)))))
 
+(define (r-conditional-value-count-invalid loc if-node test-node atype)
+  (define (p short long)
+    (report2 short warning (list test-node if-node)
+            loc
+            (string-append
+             "In conditional:"
+             "~%~%"
+             "~a"
+             "~%~%"
+             "The test expression ~a"
+             "~%~%"
+             "~a")
+            (pp-fragment if-node "    ")
+            long
+            (describe-expression test-node)))
+  (if (zero? (length atype))
+      (p "Zero values for conditional"
+        "returns 0 values.")
+      (p "Too many values for conditional"
+        (sprintf "returns ~a values." (length atype)))))
+
+(define (r-let-value-count-invalid loc var let-node val-node atype)
+  (define (p short long)
+    (report2 short warning (list val-node let-node)
+            loc
+            (string-append
+             "In let expression:"
+             "~%~%"
+             "~a"
+             "~%~%"
+             "Variable `~a' is bound value from expression that ~a"
+             "~%~%"
+             "~a")
+            (pp-fragment let-node "    ")
+            (real-name var)
+            long
+            (describe-expression val-node)))
+  (if (zero? (length atype))
+      (p (sprintf "Let bind to `~a' with zero values" (real-name var))
+        "returns 0 values.")
+      (p (sprintf "Let bind to `~a' with ~a values" (real-name var) (length 
atype))
+        (sprintf "returns ~a values." (length atype)))))
+
+(define (r-assignment-value-count-invalid loc var set-node val-node atype)
+  (define (p short long)
+    (report2 short warning (list val-node set-node)
+            loc
+            (string-append
+             "In assignment:"
+             "~%~%"
+             "~a"
+             "~%~%"
+             "Variable `~a' is assigned value from expression that ~a"
+             "~%~%"
+             "~a")
+            (pp-fragment set-node "    ")
+            (strip-namespace var)
+            long
+            (describe-expression val-node)))
+  (if (zero? (length atype))
+      (p (sprintf "Assigning to `~a' with zero values" (strip-namespace var))
+        "returns 0 values.")
+      (p (sprintf "Assigning to `~a' with ~a values" (strip-namespace var) 
(length atype))
+        (sprintf "returns ~a values." (length atype)))))
+
 (define (r-pred-call-always-true loc node pred-type atype)
   (define pname (call-node-pname node))
   (report-notice
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index 993912a..e7676ee 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -560,20 +560,62 @@ Warning: Zero values returned.
 
     symbol
 
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `zero-values-for-assignment', a local procedure
-  expected a single result in assignment to `m#foo', but received zero results
+Warning: Assigning to `foo' with zero values.
+    (test-scrutinizer-message-format.scm:61) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `zero-values-for-assignment', a local procedure
+    In assignment:
+
+      (set! m#foo (scheme#values))
+
+  Variable `foo' is assigned value from expression that returns 0 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values)
+
+Warning: Zero values for conditional.
+    (test-scrutinizer-message-format.scm:62) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `zero-values-for-conditional', a local procedure
+    In conditional:
+
+      (if (scheme#values) 1 (##core#undefined))
+
+  The test expression returns 0 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values)
+
+Warning: Let bind to `a' with zero values.
+    (test-scrutinizer-message-format.scm:63) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `zero-values-for-let', a local procedure
+    In let expression:
 
-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
+      (let ((a (scheme#values))) a)
 
-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
+  Variable `a' is bound value from expression that returns 0 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values)
 
 Warning: Too many values returned.
     (test-scrutinizer-message-format.scm:65) 
@@ -609,56 +651,182 @@ Warning: Type mismatch.
 
     fixnum
 
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `too-many-values-for-assignment', a local procedure
-  expected a single result in assignment to `m#foo', but received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `too-many-values-for-conditional', a local procedure
-  expected a single result in conditional, but received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `too-many-values-for-let', a local procedure
-  expected a single result in `let' binding of `a', but received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `r-let-value-count-invalid', 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 `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `r-let-value-count-invalid', a local procedure
-  In `too-many-values-for-let', a local procedure
-  expected a single result in `let' binding of `a', but received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `r-conditional-value-count-invalid', a local procedure
-  In `zero-values-for-conditional', a local procedure
-  expected a single result in conditional, but received zero results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `r-conditional-value-count-invalid', a local procedure
-  In `too-many-values-for-conditional', a local procedure
-  expected a single result in conditional, but received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `r-assignment-value-count-invalid', a local procedure
-  In `zero-values-for-assignment', a local procedure
-  expected a single result in assignment to `m#foo', but received zero results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
-  In `local-bar', a local procedure
-  In `r-assignment-value-count-invalid', a local procedure
-  In `too-many-values-for-assignment', a local procedure
-  expected a single result in assignment to `m#foo', but received 2 results
+Warning: Assigning to `foo' with 2 values.
+    (test-scrutinizer-message-format.scm:66) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `too-many-values-for-assignment', a local procedure
+    In assignment:
+
+      (set! m#foo (scheme#values #t 2))
+
+  Variable `foo' is assigned value from expression that returns 2 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values #t 2)
+
+Warning: Too many values for conditional.
+    (test-scrutinizer-message-format.scm:67) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `too-many-values-for-conditional', a local procedure
+    In conditional:
+
+      (if (scheme#values (the * 1) 2) 1 (##core#undefined))
+
+  The test expression returns 2 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values (the * 1) 2)
+
+Warning: Let bind to `a' with 2 values.
+    (test-scrutinizer-message-format.scm:68) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `too-many-values-for-let', a local procedure
+    In let expression:
+
+      (let ((a (scheme#values 1 2))) a)
+
+  Variable `a' is bound value from expression that returns 2 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values 1 2)
+
+Warning: Let bind to `a' with zero values.
+    (test-scrutinizer-message-format.scm:71) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `r-let-value-count-invalid', a local procedure
+    In `zero-values-for-let', a local procedure
+    In let expression:
+
+      (let ((a (scheme#values))) a)
+
+  Variable `a' is bound value from expression that returns 0 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values)
+
+Warning: Let bind to `a' with 2 values.
+    (test-scrutinizer-message-format.scm:72) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `r-let-value-count-invalid', a local procedure
+    In `too-many-values-for-let', a local procedure
+    In let expression:
+
+      (let ((a (scheme#values 1 2))) a)
+
+  Variable `a' is bound value from expression that returns 2 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values 1 2)
+
+Warning: Zero values for conditional.
+    (test-scrutinizer-message-format.scm:74) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `r-conditional-value-count-invalid', a local procedure
+    In `zero-values-for-conditional', a local procedure
+    In conditional:
+
+      (if (scheme#values) 1 (##core#undefined))
+
+  The test expression returns 0 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values)
+
+Warning: Too many values for conditional.
+    (test-scrutinizer-message-format.scm:75) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `r-conditional-value-count-invalid', a local procedure
+    In `too-many-values-for-conditional', a local procedure
+    In conditional:
+
+      (if (scheme#values (the * 1) 2) 1 (##core#undefined))
+
+  The test expression returns 2 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values (the * 1) 2)
+
+Warning: Assigning to `foo' with zero values.
+    (test-scrutinizer-message-format.scm:77) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `r-assignment-value-count-invalid', a local procedure
+    In `zero-values-for-assignment', a local procedure
+    In assignment:
+
+      (set! m#foo (scheme#values))
+
+  Variable `foo' is assigned value from expression that returns 0 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values)
+
+Warning: Assigning to `foo' with 2 values.
+    (test-scrutinizer-message-format.scm:78) 
+    In `m#toplevel-foo', a toplevel procedure
+    In `local-bar', a local procedure
+    In `r-assignment-value-count-invalid', a local procedure
+    In `too-many-values-for-assignment', a local procedure
+    In assignment:
+
+      (set! m#foo (scheme#values #t 2))
+
+  Variable `foo' is assigned value from expression that returns 2 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values #t 2)
 
 Warning: Invalid argument type.
     (test-scrutinizer-message-format.scm:80) 
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 2c27951..13579e6 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -185,8 +185,22 @@ Warning: Invalid assigned value type.
 
     (procedure scheme#car ((pair 'a *)) 'a)
 
-Warning: At toplevel:
-  expected a single result in `let' binding of `g19', but received 2 results
+Warning: Let bind to `g19' with 2 values.
+    (scrutiny-tests.scm:33) 
+    At toplevel:
+    In let expression:
+
+      (let ((g19 (scheme#values 1 2))) (g19))
+
+  Variable `g19' is bound value from expression that returns 2 values.
+
+  The expression is a call to `values' from module `scheme' which has this 
type:
+
+    (procedure scheme#values (&rest values) . *)
+
+  This is the expression:
+
+    (scheme#values 1 2)
 
 Warning: Invalid procedure.
     At toplevel:
-- 
2.7.4

>From 1c6cb7ee879699093eb4ebc92fa001f9b5864227 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Wed, 28 Nov 2018 10:59:46 +0200
Subject: [PATCH 08/12] * scrutinizer.scm (type->pp-string): Print '(Name:
 foo)' for procedures"

Print the procedure name separately so that we can use the -> style
for procedures.

Perhaps we  could skip printing  the name altogether as  it's probably
printed somewhere else in an error message and thus adds only clutter.

+ update *.expected
---
 scrutinizer.scm                           | 25 +++++++++++++++----------
 tests/scrutinizer-message-format.expected |  4 +++-
 tests/scrutiny.expected                   |  8 ++++++--
 3 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index a443215..890184c 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2353,14 +2353,7 @@
        s)))
 
 (define (type->pp-string t #!optional (proc-name? #t) (bomb? #t))
-  (define (pr t)
-    (string-add-indent
-     (string-chomp
-      (with-output-to-string
-       (lambda ()
-         (pp t))))
-     "  "))
-
+  (define pname? proc-name?)
   (define (conv t #!optional (tv-replacements '()))
     (define (R t) (conv t tv-replacements))
     (cond
@@ -2387,7 +2380,7 @@
                       (if (eq? '* res)
                           #f
                           (map R res)))))
-           (if (or (and proc-name? (procedure-name t))
+           (if (or (and pname? (procedure-name t))
                    ;; '. *' return type not supported by ->
                    (not res))
                `(procedure ,@(if (procedure-name t) (list (procedure-name t)) 
'())
@@ -2399,7 +2392,19 @@
                         ,@res))))
         (bomb? (bomb "type->pp-string: unhandled type" t))
         (else t))))))
-  (pr (conv (strip-syntax t))))
+
+  (let ((pname (procedure-name t)))
+    ;; Sign with pname? that the name has already been printed
+    (when pname (set! pname? #f))
+
+    (let ((t* (conv (strip-syntax t))))
+      (string-add-indent
+       (string-chomp
+       (with-output-to-string
+         (lambda ()
+           (pp t*)
+           (when (and proc-name? pname) (printf "~%(Name: ~a)" (real-name 
pname))))))
+       "  "))))
 
 (define (fragment x)
   (let ((x (build-expression-tree (source-node-tree x))))
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index e7676ee..1f52754 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -318,7 +318,9 @@ Warning: Invalid argument type.
 
   Argument #1 to procedure `string-length' has invalid type:
 
-    (procedure chicken.base#add1 (number) number)
+    (number -> number)
+
+    (Name: chicken.base#add1)
 
   The expected type is:
 
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 13579e6..4b338ec 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -183,7 +183,9 @@ Warning: Invalid assigned value type.
 
   The declared type of `car' from module `scheme' is:
 
-    (procedure scheme#car ((pair 'a *)) 'a)
+    ((pair 'a *) -> 'a)
+
+    (Name: scheme#car)
 
 Warning: Let bind to `g19' with 2 values.
     (scrutiny-tests.scm:33) 
@@ -222,7 +224,9 @@ Note: Test always true.
 
   Test condition has always true value of type:
 
-    (procedure bar () *)
+    (-> *)
+
+    (Name: bar)
 
 Warning: Invalid argument type.
     (scrutiny-tests.scm:58) 
-- 
2.7.4

>From 1911f3aa3f4f2d933be574869eabadf0732c4563 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Wed, 28 Nov 2018 13:24:50 +0200
Subject: [PATCH 09/12] * scrutinizer.scm: Add "In file ...", "In module ..."
 to messages

Print 'a.module.name#foo-bar-baz' as:
In file `...',
In module `a.module.name',
In procedure `foo-bar-baz' (toplevel),

* scrutinizer.scm (node-source-prefix): "In file ..."

* scrutinizer.scm (location-name): Of course bar#foo doesn't
  necessarily mean function 'foo' from module 'bar, but the behaviour
  should be easy to explain to a newcomer.

  - Also, tweak the procedure stack output a bit

* scrutinizer.scm (variable-and-module) : extract from variable-from-module

* scrutinizer.scm (variable-from-module): use variable-and-module

+ update *.expected
---
 scrutinizer.scm                           |  31 ++-
 tests/scrutinizer-message-format.expected | 385 ++++++++++++++++--------------
 tests/scrutiny-2.expected                 |  88 +++----
 tests/scrutiny.expected                   | 259 ++++++++++----------
 tests/specialization.expected             |  32 +--
 5 files changed, 423 insertions(+), 372 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 890184c..35c3a26 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2429,29 +2429,44 @@
 
 (define (node-source-prefix n)
   (let ((line (node-line-number n)))
-    (if (not line) "" (sprintf "(~a) " line))))
+    (if (not line) "" (sprintf "In file `~a'," line))))
 
 (define (location-name loc #!optional (ind "  "))
   (define (lname loc1)
     (if loc1
        (real-name loc1)
        "(unknown procedure)"))
-  (cond ((null? loc) (sprintf "At toplevel:\n~a" ind))
+  (cond ((null? loc) (sprintf "At toplevel,\n~a" ind))
        (else
         (let rec ((loc loc)
                   (msgs (list "")))
           (if (null? (cdr loc))
               (string-intersperse
-               (cons (sprintf "In `~a', a toplevel procedure" (lname (car 
loc))) msgs)
+               (cons (if (car loc)
+                         ;; If the first location is of format
+                         ;; bar#foo interpret it as being procedure
+                         ;; 'foo' in module 'bar'.
+                         (receive (var mod) (variable-and-module (real-name 
(car loc)))
+                           (sprintf "~aIn procedure `~a' (toplevel),"
+                                    (if mod (sprintf "In module `~a',~%~a" mod 
ind) "")
+                                    var))
+                         "In unknown toplevel procedure") msgs)
                (sprintf "\n~a" ind))
               (rec (cdr loc)
-                   (cons (sprintf "In `~a', a local procedure" (lname (car 
loc))) msgs)))))))
+                   (cons (sprintf "In procedure `~a'," (lname (car loc))) 
msgs)))))))
 
-(define (variable-from-module sym)
-  (let ((r (string-split (symbol->string sym) "#" #t)))
+(define (variable-and-module name) ; -> (values var module-or-false)
+  (let* ((str-name (if (symbol? name) (symbol->string name) name))
+        (r (string-split str-name "#" #t)))
     (if (= (length r) 2)
-       (sprintf "`~a' from module `~a'" (second r) (first r))
-       (sprintf "`~a'" sym))))
+       (values (string->symbol (second r)) (string->symbol (first r)))
+       (values (string->symbol str-name) #f))))
+
+(define (variable-from-module sym)
+  (receive (var mod) (variable-and-module sym)
+    (if mod
+       (sprintf "`~a' from module `~a'" var mod)
+       (sprintf "`~a'" var))))
 
 (define (describe-expression node)
   (define (p-expr n)
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index 1f52754..fbe91f7 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -4,8 +4,8 @@ Warning: literal in operator position: (1 2)
 Warning: literal in operator position: (1 2)
 
 Warning: Wrong number of arguments.
-    (test-scrutinizer-message-format.scm:9) 
-    In `r-proc-call-argument-count-mismatch', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:9',
+    In procedure `r-proc-call-argument-count-mismatch' (toplevel),
     In procedure call:
 
       (scheme#cons '())
@@ -17,8 +17,8 @@ Warning: Wrong number of arguments.
     ('a 'b --> (pair 'a 'b))
 
 Warning: Invalid argument type.
-    (test-scrutinizer-message-format.scm:10) 
-    In `r-proc-call-argument-type-mismatch', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:10',
+    In procedure `r-proc-call-argument-type-mismatch' (toplevel),
     In procedure call:
 
       (scheme#length 'symbol)
@@ -40,8 +40,8 @@ Warning: Invalid argument type.
     (list -> fixnum)
 
 Warning: Too many argument values.
-    (test-scrutinizer-message-format.scm:11) 
-    In `r-proc-call-argument-value-count', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:11',
+    In procedure `r-proc-call-argument-value-count' (toplevel),
     In procedure call:
 
       (scheme#list (chicken.time#cpu-time))
@@ -57,8 +57,8 @@ Warning: Too many argument values.
     (chicken.time#cpu-time)
 
 Warning: No values returned for argument.
-    (test-scrutinizer-message-format.scm:11) 
-    In `r-proc-call-argument-value-count', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:11',
+    In procedure `r-proc-call-argument-value-count' (toplevel),
     In procedure call:
 
       (scheme#vector (scheme#values))
@@ -74,8 +74,8 @@ Warning: No values returned for argument.
     (scheme#values)
 
 Warning: Branch value count mismatch.
-    (test-scrutinizer-message-format.scm:12) 
-    In `r-cond-branch-value-count-mismatch', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:12',
+    In procedure `r-cond-branch-value-count-mismatch' (toplevel),
     In conditional expression:
 
       (if (the * 1) 1 (chicken.time#cpu-time))
@@ -91,7 +91,7 @@ Warning: Branch value count mismatch.
     (chicken.time#cpu-time)
 
 Warning: Invalid procedure.
-    In `r-invalid-called-procedure-type', a toplevel procedure
+    In procedure `r-invalid-called-procedure-type' (toplevel),
     In procedure call:
 
       (1 2)
@@ -111,8 +111,8 @@ Warning: Invalid procedure.
     1
 
 Note: Predicate always true.
-    (test-scrutinizer-message-format.scm:14) 
-    In `r-pred-call-always-true', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:14',
+    In procedure `r-pred-call-always-true' (toplevel),
     In predicate call:
 
       (scheme#list? '())
@@ -128,8 +128,8 @@ Note: Predicate always true.
     null
 
 Note: Predicate always false.
-    (test-scrutinizer-message-format.scm:15) 
-    In `r-pred-call-always-false', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:15',
+    In procedure `r-pred-call-always-false' (toplevel),
     In predicate call:
 
       (scheme#symbol? 1)
@@ -145,7 +145,7 @@ Note: Predicate always false.
     fixnum
 
 Note: Test always true.
-    In `r-cond-test-always-true', a toplevel procedure
+    In procedure `r-cond-test-always-true' (toplevel),
     In conditional expression:
 
       (if 'symbol 1 (##core#undefined))
@@ -155,7 +155,7 @@ Note: Test always true.
     symbol
 
 Note: Test always false.
-    In `r-cond-test-always-false', a toplevel procedure
+    In procedure `r-cond-test-always-false' (toplevel),
     In conditional expression:
 
       (if #f 1 (##core#undefined))
@@ -163,7 +163,7 @@ Note: Test always false.
   Test condition is always false.
 
 Warning: Type mismatch.
-    In `r-type-mismatch-in-the', a toplevel procedure
+    In procedure `r-type-mismatch-in-the' (toplevel),
     In expression:
 
       1
@@ -179,8 +179,8 @@ Warning: Type mismatch.
     fixnum
 
 Warning: Zero values returned.
-    (test-scrutinizer-message-format.scm:19) 
-    In `r-zero-values-for-the', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:19',
+    In procedure `r-zero-values-for-the' (toplevel),
     In expression:
 
       (scheme#values)
@@ -190,8 +190,8 @@ Warning: Zero values returned.
     symbol
 
 Warning: Too many values returned.
-    (test-scrutinizer-message-format.scm:20) 
-    In `r-too-many-values-for-the', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:20',
+    In procedure `r-too-many-values-for-the' (toplevel),
     In expression:
 
       (scheme#values 1 2)
@@ -203,8 +203,8 @@ Warning: Too many values returned.
     symbol
 
 Warning: Type mismatch.
-    (test-scrutinizer-message-format.scm:20) 
-    In `r-too-many-values-for-the', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:20',
+    In procedure `r-too-many-values-for-the' (toplevel),
     In expression:
 
       (scheme#values 1 2)
@@ -220,7 +220,7 @@ Warning: Type mismatch.
     fixnum
 
 Warning: Invalid assigned value type.
-    In `r-toplevel-var-assignment-type-mismatch', a toplevel procedure
+    In procedure `r-toplevel-var-assignment-type-mismatch' (toplevel),
     In assignment:
 
       (set! foo 1)
@@ -236,7 +236,7 @@ Warning: Invalid assigned value type.
     boolean
 
 Warning: Deprecated identifier `deprecated-foo'.
-    In `r-deprecated-identifier', a toplevel procedure
+    In procedure `r-deprecated-identifier' (toplevel),
     In expression:
 
       deprecated-foo
@@ -244,7 +244,7 @@ Warning: Deprecated identifier `deprecated-foo'.
   Use of deprecated `deprecated-foo'.
 
 Warning: Deprecated identifier `deprecated-foo2'.
-    In `r-deprecated-identifier', a toplevel procedure
+    In procedure `r-deprecated-identifier' (toplevel),
     In expression:
 
       deprecated-foo2
@@ -254,7 +254,7 @@ Warning: Deprecated identifier `deprecated-foo2'.
   The suggested replacement is `foo'.
 
 Warning: Invalid assigned value type.
-    At toplevel:
+    At toplevel,
     In assignment:
 
       (set! foo 1)
@@ -270,8 +270,8 @@ Warning: Invalid assigned value type.
     boolean
 
 Warning: Invalid argument type.
-    (test-scrutinizer-message-format.scm:26) 
-    In `append-invalid-arg', a toplevel procedure
+    In file `test-scrutinizer-message-format.scm:26',
+    In procedure `append-invalid-arg' (toplevel),
     In procedure call:
 
       (scheme#append 1 (scheme#list 1))
@@ -293,10 +293,11 @@ Warning: Invalid argument type.
     (&rest * -> *)
 
 Warning: Wrong number of arguments.
-    (test-scrutinizer-message-format.scm:45) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-proc-call-argument-count-mismatch', a local procedure
+    In file `test-scrutinizer-message-format.scm:45',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-proc-call-argument-count-mismatch',
     In procedure call:
 
       (scheme#cons '())
@@ -308,10 +309,11 @@ Warning: Wrong number of arguments.
     ('a 'b --> (pair 'a 'b))
 
 Warning: Invalid argument type.
-    (test-scrutinizer-message-format.scm:46) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-proc-call-argument-type-mismatch', a local procedure
+    In file `test-scrutinizer-message-format.scm:46',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-proc-call-argument-type-mismatch',
     In procedure call:
 
       (scheme#string-length chicken.base#add1)
@@ -335,10 +337,11 @@ Warning: Invalid argument type.
     (string -> fixnum)
 
 Warning: Too many argument values.
-    (test-scrutinizer-message-format.scm:47) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-proc-call-argument-value-count', a local procedure
+    In file `test-scrutinizer-message-format.scm:47',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-proc-call-argument-value-count',
     In procedure call:
 
       (scheme#list (chicken.time#cpu-time))
@@ -354,10 +357,11 @@ Warning: Too many argument values.
     (chicken.time#cpu-time)
 
 Warning: No values returned for argument.
-    (test-scrutinizer-message-format.scm:47) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-proc-call-argument-value-count', a local procedure
+    In file `test-scrutinizer-message-format.scm:47',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-proc-call-argument-value-count',
     In procedure call:
 
       (scheme#vector (scheme#values))
@@ -373,10 +377,11 @@ Warning: No values returned for argument.
     (scheme#values)
 
 Warning: Branch value count mismatch.
-    (test-scrutinizer-message-format.scm:48) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-cond-branch-value-count-mismatch', a local procedure
+    In file `test-scrutinizer-message-format.scm:48',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-cond-branch-value-count-mismatch',
     In conditional expression:
 
       (if (the * 1) 1 (chicken.time#cpu-time))
@@ -392,11 +397,12 @@ Warning: Branch value count mismatch.
     (chicken.time#cpu-time)
 
 Warning: Invalid procedure.
-    (test-scrutinizer-message-format.scm:50) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-invalid-called-procedure-type', a local procedure
-    In `variable', a local procedure
+    In file `test-scrutinizer-message-format.scm:50',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-invalid-called-procedure-type',
+    In procedure `variable',
     In procedure call:
 
       (m#foo2 2)
@@ -408,10 +414,11 @@ Warning: Invalid procedure.
     boolean
 
 Warning: Invalid procedure.
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-invalid-called-procedure-type', a local procedure
-    In `non-variable', a local procedure
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-invalid-called-procedure-type',
+    In procedure `non-variable',
     In procedure call:
 
       (1 2)
@@ -431,10 +438,11 @@ Warning: Invalid procedure.
     1
 
 Note: Predicate always true.
-    (test-scrutinizer-message-format.scm:52) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-pred-call-always-true', a local procedure
+    In file `test-scrutinizer-message-format.scm:52',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-pred-call-always-true',
     In predicate call:
 
       (scheme#list? '())
@@ -450,10 +458,11 @@ Note: Predicate always true.
     null
 
 Note: Predicate always false.
-    (test-scrutinizer-message-format.scm:53) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-pred-call-always-false', a local procedure
+    In file `test-scrutinizer-message-format.scm:53',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-pred-call-always-false',
     In predicate call:
 
       (scheme#symbol? 1)
@@ -469,10 +478,11 @@ Note: Predicate always false.
     fixnum
 
 Note: Test always true.
-    (test-scrutinizer-message-format.scm:54) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-cond-test-always-true', a local procedure
+    In file `test-scrutinizer-message-format.scm:54',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-cond-test-always-true',
     In conditional expression:
 
       (if (scheme#length '()) 1 (##core#undefined))
@@ -482,9 +492,10 @@ Note: Test always true.
     fixnum
 
 Note: Test always false.
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-cond-test-always-false', a local procedure
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-cond-test-always-false',
     In conditional expression:
 
       (if #f 1 (##core#undefined))
@@ -492,9 +503,10 @@ Note: Test always false.
   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 module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-type-mismatch-in-the',
     In expression:
 
       1
@@ -510,9 +522,10 @@ Warning: Type mismatch.
     fixnum
 
 Warning: Invalid assigned value type.
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-toplevel-var-assignment-type-mismatch', a local procedure
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-toplevel-var-assignment-type-mismatch',
     In assignment:
 
       (set! m#foo2 1)
@@ -528,9 +541,10 @@ Warning: Invalid assigned value type.
     boolean
 
 Warning: Deprecated identifier `deprecated-foo'.
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-deprecated-identifier', a local procedure
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-deprecated-identifier',
     In expression:
 
       m#deprecated-foo
@@ -538,9 +552,10 @@ Warning: Deprecated identifier `deprecated-foo'.
   Use of deprecated `deprecated-foo' from module `m'.
 
 Warning: Deprecated identifier `deprecated-foo2'.
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-deprecated-identifier', a local procedure
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-deprecated-identifier',
     In expression:
 
       m#deprecated-foo2
@@ -550,10 +565,11 @@ Warning: Deprecated identifier `deprecated-foo2'.
   The suggested replacement is `foo'.
 
 Warning: Zero values returned.
-    (test-scrutinizer-message-format.scm:60) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-zero-values-for-the', a local procedure
+    In file `test-scrutinizer-message-format.scm:60',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-zero-values-for-the',
     In expression:
 
       (scheme#values)
@@ -563,10 +579,11 @@ Warning: Zero values returned.
     symbol
 
 Warning: Assigning to `foo' with zero values.
-    (test-scrutinizer-message-format.scm:61) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `zero-values-for-assignment', a local procedure
+    In file `test-scrutinizer-message-format.scm:61',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `zero-values-for-assignment',
     In assignment:
 
       (set! m#foo (scheme#values))
@@ -582,10 +599,11 @@ Warning: Assigning to `foo' with zero values.
     (scheme#values)
 
 Warning: Zero values for conditional.
-    (test-scrutinizer-message-format.scm:62) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `zero-values-for-conditional', a local procedure
+    In file `test-scrutinizer-message-format.scm:62',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `zero-values-for-conditional',
     In conditional:
 
       (if (scheme#values) 1 (##core#undefined))
@@ -601,10 +619,11 @@ Warning: Zero values for conditional.
     (scheme#values)
 
 Warning: Let bind to `a' with zero values.
-    (test-scrutinizer-message-format.scm:63) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `zero-values-for-let', a local procedure
+    In file `test-scrutinizer-message-format.scm:63',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `zero-values-for-let',
     In let expression:
 
       (let ((a (scheme#values))) a)
@@ -620,10 +639,11 @@ Warning: Let bind to `a' with zero values.
     (scheme#values)
 
 Warning: Too many values returned.
-    (test-scrutinizer-message-format.scm:65) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-too-many-values-for-the', a local procedure
+    In file `test-scrutinizer-message-format.scm:65',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-too-many-values-for-the',
     In expression:
 
       (scheme#values 1 2)
@@ -635,10 +655,11 @@ Warning: Too many values returned.
     symbol
 
 Warning: Type mismatch.
-    (test-scrutinizer-message-format.scm:65) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-too-many-values-for-the', a local procedure
+    In file `test-scrutinizer-message-format.scm:65',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-too-many-values-for-the',
     In expression:
 
       (scheme#values 1 2)
@@ -654,10 +675,11 @@ Warning: Type mismatch.
     fixnum
 
 Warning: Assigning to `foo' with 2 values.
-    (test-scrutinizer-message-format.scm:66) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `too-many-values-for-assignment', a local procedure
+    In file `test-scrutinizer-message-format.scm:66',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `too-many-values-for-assignment',
     In assignment:
 
       (set! m#foo (scheme#values #t 2))
@@ -673,10 +695,11 @@ Warning: Assigning to `foo' with 2 values.
     (scheme#values #t 2)
 
 Warning: Too many values for conditional.
-    (test-scrutinizer-message-format.scm:67) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `too-many-values-for-conditional', a local procedure
+    In file `test-scrutinizer-message-format.scm:67',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `too-many-values-for-conditional',
     In conditional:
 
       (if (scheme#values (the * 1) 2) 1 (##core#undefined))
@@ -692,10 +715,11 @@ Warning: Too many values for conditional.
     (scheme#values (the * 1) 2)
 
 Warning: Let bind to `a' with 2 values.
-    (test-scrutinizer-message-format.scm:68) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `too-many-values-for-let', a local procedure
+    In file `test-scrutinizer-message-format.scm:68',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `too-many-values-for-let',
     In let expression:
 
       (let ((a (scheme#values 1 2))) a)
@@ -711,11 +735,12 @@ Warning: Let bind to `a' with 2 values.
     (scheme#values 1 2)
 
 Warning: Let bind to `a' with zero values.
-    (test-scrutinizer-message-format.scm:71) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-let-value-count-invalid', a local procedure
-    In `zero-values-for-let', a local procedure
+    In file `test-scrutinizer-message-format.scm:71',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-let-value-count-invalid',
+    In procedure `zero-values-for-let',
     In let expression:
 
       (let ((a (scheme#values))) a)
@@ -731,11 +756,12 @@ Warning: Let bind to `a' with zero values.
     (scheme#values)
 
 Warning: Let bind to `a' with 2 values.
-    (test-scrutinizer-message-format.scm:72) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-let-value-count-invalid', a local procedure
-    In `too-many-values-for-let', a local procedure
+    In file `test-scrutinizer-message-format.scm:72',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-let-value-count-invalid',
+    In procedure `too-many-values-for-let',
     In let expression:
 
       (let ((a (scheme#values 1 2))) a)
@@ -751,11 +777,12 @@ Warning: Let bind to `a' with 2 values.
     (scheme#values 1 2)
 
 Warning: Zero values for conditional.
-    (test-scrutinizer-message-format.scm:74) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-conditional-value-count-invalid', a local procedure
-    In `zero-values-for-conditional', a local procedure
+    In file `test-scrutinizer-message-format.scm:74',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-conditional-value-count-invalid',
+    In procedure `zero-values-for-conditional',
     In conditional:
 
       (if (scheme#values) 1 (##core#undefined))
@@ -771,11 +798,12 @@ Warning: Zero values for conditional.
     (scheme#values)
 
 Warning: Too many values for conditional.
-    (test-scrutinizer-message-format.scm:75) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-conditional-value-count-invalid', a local procedure
-    In `too-many-values-for-conditional', a local procedure
+    In file `test-scrutinizer-message-format.scm:75',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-conditional-value-count-invalid',
+    In procedure `too-many-values-for-conditional',
     In conditional:
 
       (if (scheme#values (the * 1) 2) 1 (##core#undefined))
@@ -791,11 +819,12 @@ Warning: Too many values for conditional.
     (scheme#values (the * 1) 2)
 
 Warning: Assigning to `foo' with zero values.
-    (test-scrutinizer-message-format.scm:77) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-assignment-value-count-invalid', a local procedure
-    In `zero-values-for-assignment', a local procedure
+    In file `test-scrutinizer-message-format.scm:77',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-assignment-value-count-invalid',
+    In procedure `zero-values-for-assignment',
     In assignment:
 
       (set! m#foo (scheme#values))
@@ -811,11 +840,12 @@ Warning: Assigning to `foo' with zero values.
     (scheme#values)
 
 Warning: Assigning to `foo' with 2 values.
-    (test-scrutinizer-message-format.scm:78) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `r-assignment-value-count-invalid', a local procedure
-    In `too-many-values-for-assignment', a local procedure
+    In file `test-scrutinizer-message-format.scm:78',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `r-assignment-value-count-invalid',
+    In procedure `too-many-values-for-assignment',
     In assignment:
 
       (set! m#foo (scheme#values #t 2))
@@ -831,10 +861,11 @@ Warning: Assigning to `foo' with 2 values.
     (scheme#values #t 2)
 
 Warning: Invalid argument type.
-    (test-scrutinizer-message-format.scm:80) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `append-invalid-arg', a local procedure
+    In file `test-scrutinizer-message-format.scm:80',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `append-invalid-arg',
     In procedure call:
 
       (scheme#append 1 (scheme#list 1))
@@ -856,11 +887,12 @@ Warning: Invalid argument type.
     (&rest * -> *)
 
 Warning: List index negative.
-    (test-scrutinizer-message-format.scm:82) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `vector-list-out-of-range', a local procedure
-    In `list-ref-negative-index', a local procedure
+    In file `test-scrutinizer-message-format.scm:82',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `vector-list-out-of-range',
+    In procedure `list-ref-negative-index',
     In procedure call:
 
       (scheme#list-ref '() -1)
@@ -868,11 +900,12 @@ Warning: List index negative.
   Calling `list-ref' from module `scheme' with a negative index -1.
 
 Warning: List index out of range.
-    (test-scrutinizer-message-format.scm:83) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `vector-list-out-of-range', a local procedure
-    In `list-ref-out-of-range', a local procedure
+    In file `test-scrutinizer-message-format.scm:83',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `vector-list-out-of-range',
+    In procedure `list-ref-out-of-range',
     In procedure call:
 
       (scheme#list-ref '() 1)
@@ -880,11 +913,12 @@ Warning: List index out of range.
   Calling `list-ref' from module `scheme' with index `1' for a list of length 
`0'.
 
 Warning: Vector index negative.
-    (test-scrutinizer-message-format.scm:84) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `vector-list-out-of-range', a local procedure
-    In `vector-ref-out-of-range', a local procedure
+    In file `test-scrutinizer-message-format.scm:84',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `vector-list-out-of-range',
+    In procedure `vector-ref-out-of-range',
     In procedure call:
 
       (scheme#vector-ref (scheme#vector) -1)
@@ -892,10 +926,11 @@ Warning: Vector index negative.
   Calling `vector-ref' from module `scheme' with a negative index -1.
 
 Error: No typecase matches.
-    (test-scrutinizer-message-format.scm:86) 
-    In `m#toplevel-foo', a toplevel procedure
-    In `local-bar', a local procedure
-    In `fail-compiler-typecase', a local procedure
+    In file `test-scrutinizer-message-format.scm:86',
+    In module `m',
+    In procedure `toplevel-foo' (toplevel),
+    In procedure `local-bar',
+    In procedure `fail-compiler-typecase',
     In `compiler-typecase' expression:
 
       (compiler-typecase g104 (symbol 1) (list 2) (else (##core#undefined)))
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index cafc076..ee42a48 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -1,7 +1,7 @@
 
 Note: Predicate always true.
-    (scrutiny-tests-2.scm:20) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:20',
+    At toplevel,
     In predicate call:
 
       (scheme#pair? p)
@@ -17,8 +17,8 @@ Note: Predicate always true.
     pair
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:20) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:20',
+    At toplevel,
     In predicate call:
 
       (scheme#pair? l)
@@ -34,8 +34,8 @@ Note: Predicate always false.
     null
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:20) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:20',
+    At toplevel,
     In predicate call:
 
       (scheme#pair? n)
@@ -51,8 +51,8 @@ Note: Predicate always false.
     null
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:20) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:20',
+    At toplevel,
     In predicate call:
 
       (scheme#pair? i)
@@ -68,8 +68,8 @@ Note: Predicate always false.
     fixnum
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:20) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:20',
+    At toplevel,
     In predicate call:
 
       (scheme#pair? f)
@@ -85,8 +85,8 @@ Note: Predicate always false.
     float
 
 Note: Predicate always true.
-    (scrutiny-tests-2.scm:21) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:21',
+    At toplevel,
     In predicate call:
 
       (scheme#list? l)
@@ -102,8 +102,8 @@ Note: Predicate always true.
     null
 
 Note: Predicate always true.
-    (scrutiny-tests-2.scm:21) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:21',
+    At toplevel,
     In predicate call:
 
       (scheme#list? n)
@@ -119,8 +119,8 @@ Note: Predicate always true.
     null
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:21) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:21',
+    At toplevel,
     In predicate call:
 
       (scheme#list? i)
@@ -136,8 +136,8 @@ Note: Predicate always false.
     fixnum
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:21) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:21',
+    At toplevel,
     In predicate call:
 
       (scheme#list? f)
@@ -153,8 +153,8 @@ Note: Predicate always false.
     float
 
 Note: Predicate always true.
-    (scrutiny-tests-2.scm:22) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:22',
+    At toplevel,
     In predicate call:
 
       (scheme#null? n)
@@ -170,8 +170,8 @@ Note: Predicate always true.
     null
 
 Note: Predicate always true.
-    (scrutiny-tests-2.scm:22) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:22',
+    At toplevel,
     In predicate call:
 
       (scheme#null? l)
@@ -187,8 +187,8 @@ Note: Predicate always true.
     null
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:22) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:22',
+    At toplevel,
     In predicate call:
 
       (scheme#null? p)
@@ -204,8 +204,8 @@ Note: Predicate always false.
     pair
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:22) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:22',
+    At toplevel,
     In predicate call:
 
       (scheme#null? i)
@@ -221,8 +221,8 @@ Note: Predicate always false.
     fixnum
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:22) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:22',
+    At toplevel,
     In predicate call:
 
       (scheme#null? f)
@@ -238,8 +238,8 @@ Note: Predicate always false.
     float
 
 Note: Predicate always true.
-    (scrutiny-tests-2.scm:23) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:23',
+    At toplevel,
     In predicate call:
 
       (chicken.base#fixnum? i)
@@ -255,8 +255,8 @@ Note: Predicate always true.
     fixnum
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:23) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:23',
+    At toplevel,
     In predicate call:
 
       (chicken.base#fixnum? f)
@@ -272,8 +272,8 @@ Note: Predicate always false.
     float
 
 Note: Predicate always true.
-    (scrutiny-tests-2.scm:25) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:25',
+    At toplevel,
     In predicate call:
 
       (chicken.base#flonum? f)
@@ -289,8 +289,8 @@ Note: Predicate always true.
     float
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:25) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:25',
+    At toplevel,
     In predicate call:
 
       (chicken.base#flonum? i)
@@ -306,8 +306,8 @@ Note: Predicate always false.
     fixnum
 
 Note: Predicate always true.
-    (scrutiny-tests-2.scm:27) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:27',
+    At toplevel,
     In predicate call:
 
       (scheme#number? i)
@@ -323,8 +323,8 @@ Note: Predicate always true.
     fixnum
 
 Note: Predicate always true.
-    (scrutiny-tests-2.scm:27) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:27',
+    At toplevel,
     In predicate call:
 
       (scheme#number? f)
@@ -340,8 +340,8 @@ Note: Predicate always true.
     float
 
 Note: Predicate always true.
-    (scrutiny-tests-2.scm:27) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:27',
+    At toplevel,
     In predicate call:
 
       (scheme#number? u)
@@ -357,8 +357,8 @@ Note: Predicate always true.
     number
 
 Note: Predicate always false.
-    (scrutiny-tests-2.scm:27) 
-    At toplevel:
+    In file `scrutiny-tests-2.scm:27',
+    At toplevel,
     In predicate call:
 
       (scheme#number? n)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 4b338ec..45d065e 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -2,9 +2,9 @@
 Warning: (scrutiny-tests.scm:31) - assignment to imported value binding `car'
 
 Note: Test always true.
-    In `a', a toplevel procedure
-    In `b', a local procedure
-    In `c', a local procedure
+    In procedure `a' (toplevel),
+    In procedure `b',
+    In procedure `c',
     In conditional expression:
 
       (if x 1 2)
@@ -14,7 +14,7 @@ Note: Test always true.
     number
 
 Note: Test always true.
-    In `b', a toplevel procedure
+    In procedure `b' (toplevel),
     In conditional expression:
 
       (if x 1 2)
@@ -24,8 +24,8 @@ Note: Test always true.
     true
 
 Warning: Branch value count mismatch.
-    (scrutiny-tests.scm:16) 
-    In `foo', a toplevel procedure
+    In file `scrutiny-tests.scm:16',
+    In procedure `foo' (toplevel),
     In conditional expression:
 
       (if x (scheme#values 1 2) (scheme#values 1 2 (scheme#+ (scheme#+ ...))))
@@ -41,8 +41,8 @@ Warning: Branch value count mismatch.
     (scheme#values 1 2 (scheme#+ (scheme#+ (scheme#+ ...))))
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:19) 
-    At toplevel:
+    In file `scrutiny-tests.scm:19',
+    At toplevel,
     In procedure call:
 
       (bar 3 'a)
@@ -64,8 +64,8 @@ Warning: Invalid argument type.
     (&rest number -> number)
 
 Warning: Wrong number of arguments.
-    (scrutiny-tests.scm:21) 
-    At toplevel:
+    In file `scrutiny-tests.scm:21',
+    At toplevel,
     In procedure call:
 
       (scheme#string?)
@@ -77,8 +77,8 @@ Warning: Wrong number of arguments.
     (* -> boolean)
 
 Warning: Too many argument values.
-    (scrutiny-tests.scm:23) 
-    At toplevel:
+    In file `scrutiny-tests.scm:23',
+    At toplevel,
     In procedure call:
 
       (chicken.base#print (scheme#values 1 2))
@@ -94,8 +94,8 @@ Warning: Too many argument values.
     (scheme#values 1 2)
 
 Warning: No values returned for argument.
-    (scrutiny-tests.scm:24) 
-    At toplevel:
+    In file `scrutiny-tests.scm:24',
+    At toplevel,
     In procedure call:
 
       (chicken.base#print (scheme#values))
@@ -111,8 +111,8 @@ Warning: No values returned for argument.
     (scheme#values)
 
 Warning: Invalid procedure.
-    (scrutiny-tests.scm:27) 
-    At toplevel:
+    In file `scrutiny-tests.scm:27',
+    At toplevel,
     In procedure call:
 
       (x)
@@ -124,8 +124,8 @@ Warning: Invalid procedure.
     fixnum
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:29) 
-    At toplevel:
+    In file `scrutiny-tests.scm:29',
+    At toplevel,
     In procedure call:
 
       (scheme#+ 'a 'b)
@@ -147,8 +147,8 @@ Warning: Invalid argument type.
     (&rest number -> number)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:29) 
-    At toplevel:
+    In file `scrutiny-tests.scm:29',
+    At toplevel,
     In procedure call:
 
       (scheme#+ 'a 'b)
@@ -170,7 +170,7 @@ Warning: Invalid argument type.
     (&rest number -> number)
 
 Warning: Invalid assigned value type.
-    At toplevel:
+    At toplevel,
     In assignment:
 
       (set! scheme#car 33)
@@ -188,8 +188,8 @@ Warning: Invalid assigned value type.
     (Name: scheme#car)
 
 Warning: Let bind to `g19' with 2 values.
-    (scrutiny-tests.scm:33) 
-    At toplevel:
+    In file `scrutiny-tests.scm:33',
+    At toplevel,
     In let expression:
 
       (let ((g19 (scheme#values 1 2))) (g19))
@@ -205,7 +205,7 @@ Warning: Let bind to `g19' with 2 values.
     (scheme#values 1 2)
 
 Warning: Invalid procedure.
-    At toplevel:
+    At toplevel,
     In procedure call:
 
       (g19)
@@ -217,7 +217,7 @@ Warning: Invalid procedure.
     fixnum
 
 Note: Test always true.
-    In `foo', a toplevel procedure
+    In procedure `foo' (toplevel),
     In conditional expression:
 
       (if bar 3 (##core#undefined))
@@ -229,8 +229,8 @@ Note: Test always true.
     (Name: bar)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:58) 
-    In `foo2', a toplevel procedure
+    In file `scrutiny-tests.scm:58',
+    In procedure `foo2' (toplevel),
     In procedure call:
 
       (scheme#string-append x "abc")
@@ -252,8 +252,8 @@ Warning: Invalid argument type.
     (&rest string -> string)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:66) 
-    At toplevel:
+    In file `scrutiny-tests.scm:66',
+    At toplevel,
     In procedure call:
 
       (foo3 99)
@@ -275,8 +275,8 @@ Warning: Invalid argument type.
     (string -> string)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:71) 
-    In `foo4', a toplevel procedure
+    In file `scrutiny-tests.scm:71',
+    In procedure `foo4' (toplevel),
     In procedure call:
 
       (scheme#+ x 1)
@@ -298,8 +298,8 @@ Warning: Invalid argument type.
     (&rest number -> number)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:77) 
-    In `foo5', a toplevel procedure
+    In file `scrutiny-tests.scm:77',
+    In procedure `foo5' (toplevel),
     In procedure call:
 
       (scheme#+ x 3)
@@ -321,8 +321,8 @@ Warning: Invalid argument type.
     (&rest number -> number)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:83) 
-    In `foo6', a toplevel procedure
+    In file `scrutiny-tests.scm:83',
+    In procedure `foo6' (toplevel),
     In procedure call:
 
       (scheme#+ x 3)
@@ -344,8 +344,8 @@ Warning: Invalid argument type.
     (&rest number -> number)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:90) 
-    At toplevel:
+    In file `scrutiny-tests.scm:90',
+    At toplevel,
     In procedure call:
 
       (scheme#+ x 1)
@@ -367,8 +367,8 @@ Warning: Invalid argument type.
     (&rest number -> number)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:104) 
-    In `foo10', a toplevel procedure
+    In file `scrutiny-tests.scm:104',
+    In procedure `foo10' (toplevel),
     In procedure call:
 
       (foo9 x)
@@ -390,8 +390,8 @@ Warning: Invalid argument type.
     (string -> symbol)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:105) 
-    In `foo10', a toplevel procedure
+    In file `scrutiny-tests.scm:105',
+    In procedure `foo10' (toplevel),
     In procedure call:
 
       (scheme#+ x 1)
@@ -413,8 +413,8 @@ Warning: Invalid argument type.
     (&rest number -> number)
 
 Warning: Type mismatch.
-    (scrutiny-tests.scm:109) 
-    In `foo10', a toplevel procedure
+    In file `scrutiny-tests.scm:109',
+    In procedure `foo10' (toplevel),
     In expression:
 
       (scheme#substring x 0 10)
@@ -430,8 +430,8 @@ Warning: Type mismatch.
     string
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:109) 
-    In `foo10', a toplevel procedure
+    In file `scrutiny-tests.scm:109',
+    In procedure `foo10' (toplevel),
     In procedure call:
 
       (scheme#string-append (the pair (scheme#substring x 0 10)))
@@ -453,8 +453,8 @@ Warning: Invalid argument type.
     (&rest string -> string)
 
 Warning: Too many values returned.
-    (scrutiny-tests.scm:110) 
-    In `foo10', a toplevel procedure
+    In file `scrutiny-tests.scm:110',
+    In procedure `foo10' (toplevel),
     In expression:
 
       (scheme#values 1 2)
@@ -466,8 +466,8 @@ Warning: Too many values returned.
     *
 
 Warning: Zero values returned.
-    (scrutiny-tests.scm:111) 
-    In `foo10', a toplevel procedure
+    In file `scrutiny-tests.scm:111',
+    In procedure `foo10' (toplevel),
     In expression:
 
       (scheme#values)
@@ -477,8 +477,8 @@ Warning: Zero values returned.
     *
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:112) 
-    In `foo10', a toplevel procedure
+    In file `scrutiny-tests.scm:112',
+    In procedure `foo10' (toplevel),
     In procedure call:
 
       (scheme#* x y)
@@ -500,8 +500,9 @@ Warning: Invalid argument type.
     (&rest number -> number)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:137) 
-    In `foo#blabla', a toplevel procedure
+    In file `scrutiny-tests.scm:137',
+    In module `foo',
+    In procedure `blabla' (toplevel),
     In procedure call:
 
       (scheme#+ 1 'x)
@@ -523,7 +524,7 @@ Warning: Invalid argument type.
     (&rest number -> number)
 
 Warning: Deprecated identifier `deprecated-procedure'.
-    At toplevel:
+    At toplevel,
     In expression:
 
       deprecated-procedure
@@ -531,7 +532,7 @@ Warning: Deprecated identifier `deprecated-procedure'.
   Use of deprecated `deprecated-procedure'.
 
 Warning: Deprecated identifier `another-deprecated-procedure'.
-    At toplevel:
+    At toplevel,
     In expression:
 
       another-deprecated-procedure
@@ -541,8 +542,8 @@ Warning: Deprecated identifier 
`another-deprecated-procedure'.
   The suggested replacement is `replacement-procedure'.
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:168) 
-    At toplevel:
+    In file `scrutiny-tests.scm:168',
+    At toplevel,
     In procedure call:
 
       (apply1 scheme#+ (scheme#list 'a 2 3))
@@ -568,8 +569,8 @@ Warning: Invalid argument type.
     ((&rest 'a -> 'b) (list-of 'a) -> 'b)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:169) 
-    At toplevel:
+    In file `scrutiny-tests.scm:169',
+    At toplevel,
     In procedure call:
 
       (apply1 scheme#+ (scheme#cons 'a (scheme#cons 2 (scheme#cons 3 ...))))
@@ -595,8 +596,8 @@ Warning: Invalid argument type.
     ((&rest 'a -> 'b) (list-of 'a) -> 'b)
 
 Note: Predicate always true.
-    (scrutiny-tests.scm:182) 
-    At toplevel:
+    In file `scrutiny-tests.scm:182',
+    At toplevel,
     In predicate call:
 
       (chicken.base#fixnum? x)
@@ -612,8 +613,8 @@ Note: Predicate always true.
     fixnum
 
 Note: Predicate always false.
-    (scrutiny-tests.scm:190) 
-    At toplevel:
+    In file `scrutiny-tests.scm:190',
+    At toplevel,
     In predicate call:
 
       (scheme#symbol? x)
@@ -629,8 +630,8 @@ Note: Predicate always false.
     (or char string)
 
 Note: Predicate always false.
-    (scrutiny-tests.scm:191) 
-    At toplevel:
+    In file `scrutiny-tests.scm:191',
+    At toplevel,
     In predicate call:
 
       (scheme#string? x)
@@ -646,8 +647,8 @@ Note: Predicate always false.
     (not (or char string))
 
 Note: Predicate always false.
-    (scrutiny-tests.scm:194) 
-    At toplevel:
+    In file `scrutiny-tests.scm:194',
+    At toplevel,
     In predicate call:
 
       (char-or-string? x)
@@ -663,8 +664,8 @@ Note: Predicate always false.
     fixnum
 
 Note: Predicate always false.
-    (scrutiny-tests.scm:195) 
-    At toplevel:
+    In file `scrutiny-tests.scm:195',
+    At toplevel,
     In predicate call:
 
       (scheme#symbol? x)
@@ -680,8 +681,8 @@ Note: Predicate always false.
     (or char string)
 
 Note: Predicate always false.
-    (scrutiny-tests.scm:196) 
-    At toplevel:
+    In file `scrutiny-tests.scm:196',
+    At toplevel,
     In predicate call:
 
       (scheme#string? x)
@@ -697,8 +698,8 @@ Note: Predicate always false.
     fixnum
 
 Note: Predicate always false.
-    (scrutiny-tests.scm:200) 
-    At toplevel:
+    In file `scrutiny-tests.scm:200',
+    At toplevel,
     In predicate call:
 
       (scheme#symbol? x)
@@ -714,8 +715,8 @@ Note: Predicate always false.
     char
 
 Note: Predicate always false.
-    (scrutiny-tests.scm:201) 
-    At toplevel:
+    In file `scrutiny-tests.scm:201',
+    At toplevel,
     In predicate call:
 
       (scheme#string? x)
@@ -731,8 +732,8 @@ Note: Predicate always false.
     symbol
 
 Note: Predicate always false.
-    (scrutiny-tests.scm:205) 
-    At toplevel:
+    In file `scrutiny-tests.scm:205',
+    At toplevel,
     In predicate call:
 
       (scheme#symbol? x)
@@ -748,8 +749,8 @@ Note: Predicate always false.
     (or char string)
 
 Note: Predicate always false.
-    (scrutiny-tests.scm:206) 
-    At toplevel:
+    In file `scrutiny-tests.scm:206',
+    At toplevel,
     In predicate call:
 
       (scheme#string? x)
@@ -765,8 +766,8 @@ Note: Predicate always false.
     symbol
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:210) 
-    At toplevel:
+    In file `scrutiny-tests.scm:210',
+    At toplevel,
     In procedure call:
 
       (f (scheme#list))
@@ -792,8 +793,8 @@ Warning: Invalid argument type.
     (pair -> *)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:212) 
-    At toplevel:
+    In file `scrutiny-tests.scm:212',
+    At toplevel,
     In procedure call:
 
       (f (scheme#list 1))
@@ -819,8 +820,8 @@ Warning: Invalid argument type.
     (null -> *)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:214) 
-    At toplevel:
+    In file `scrutiny-tests.scm:214',
+    At toplevel,
     In procedure call:
 
       (f (scheme#cons 1 2))
@@ -846,8 +847,8 @@ Warning: Invalid argument type.
     (list -> *)
 
 Warning: Vector index negative.
-    (scrutiny-tests.scm:220) 
-    In `vector-ref-warn1', a toplevel procedure
+    In file `scrutiny-tests.scm:220',
+    In procedure `vector-ref-warn1' (toplevel),
     In procedure call:
 
       (scheme#vector-ref v1 -1)
@@ -855,8 +856,8 @@ Warning: Vector index negative.
   Calling `vector-ref' from module `scheme' with a negative index -1.
 
 Warning: Vector index out of range.
-    (scrutiny-tests.scm:222) 
-    In `vector-ref-warn2', a toplevel procedure
+    In file `scrutiny-tests.scm:222',
+    In procedure `vector-ref-warn2' (toplevel),
     In procedure call:
 
       (scheme#vector-ref v1 3)
@@ -864,8 +865,8 @@ Warning: Vector index out of range.
   Calling `vector-ref' from module `scheme' with index `3' for a vector of 
length `3'.
 
 Warning: Vector index out of range.
-    (scrutiny-tests.scm:223) 
-    In `vector-ref-warn3', a toplevel procedure
+    In file `scrutiny-tests.scm:223',
+    In procedure `vector-ref-warn3' (toplevel),
     In procedure call:
 
       (scheme#vector-ref v1 4)
@@ -873,8 +874,8 @@ Warning: Vector index out of range.
   Calling `vector-ref' from module `scheme' with index `4' for a vector of 
length `3'.
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:226) 
-    In `vector-ref-standard-warn1', a toplevel procedure
+    In file `scrutiny-tests.scm:226',
+    In procedure `vector-ref-standard-warn1' (toplevel),
     In procedure call:
 
       (scheme#vector-ref v1 'bad)
@@ -896,8 +897,8 @@ Warning: Invalid argument type.
     ((vector-of 'a) fixnum -> 'a)
 
 Warning: Vector index negative.
-    (scrutiny-tests.scm:227) 
-    In `vector-set!-warn1', a toplevel procedure
+    In file `scrutiny-tests.scm:227',
+    In procedure `vector-set!-warn1' (toplevel),
     In procedure call:
 
       (scheme#vector-set! v1 -1 'whatever)
@@ -905,8 +906,8 @@ Warning: Vector index negative.
   Calling `vector-set!' from module `scheme' with a negative index -1.
 
 Warning: Vector index out of range.
-    (scrutiny-tests.scm:228) 
-    In `vector-set!-warn2', a toplevel procedure
+    In file `scrutiny-tests.scm:228',
+    In procedure `vector-set!-warn2' (toplevel),
     In procedure call:
 
       (scheme#vector-set! v1 3 'whatever)
@@ -914,8 +915,8 @@ Warning: Vector index out of range.
   Calling `vector-set!' from module `scheme' with index `3' for a vector of 
length `3'.
 
 Warning: Vector index out of range.
-    (scrutiny-tests.scm:229) 
-    In `vector-set!-warn3', a toplevel procedure
+    In file `scrutiny-tests.scm:229',
+    In procedure `vector-set!-warn3' (toplevel),
     In procedure call:
 
       (scheme#vector-set! v1 4 'whatever)
@@ -923,8 +924,8 @@ Warning: Vector index out of range.
   Calling `vector-set!' from module `scheme' with index `4' for a vector of 
length `3'.
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:232) 
-    In `vector-set!-standard-warn1', a toplevel procedure
+    In file `scrutiny-tests.scm:232',
+    In procedure `vector-set!-standard-warn1' (toplevel),
     In procedure call:
 
       (scheme#vector-set! v1 'bad 'whatever)
@@ -946,8 +947,8 @@ Warning: Invalid argument type.
     (vector fixnum * -> undefined)
 
 Warning: List index negative.
-    (scrutiny-tests.scm:238) 
-    In `list-ref-warn1', a toplevel procedure
+    In file `scrutiny-tests.scm:238',
+    In procedure `list-ref-warn1' (toplevel),
     In procedure call:
 
       (scheme#list-ref l1 -1)
@@ -955,8 +956,8 @@ Warning: List index negative.
   Calling `list-ref' from module `scheme' with a negative index -1.
 
 Warning: List index negative.
-    (scrutiny-tests.scm:241) 
-    In `list-ref-warn2', a toplevel procedure
+    In file `scrutiny-tests.scm:241',
+    In procedure `list-ref-warn2' (toplevel),
     In procedure call:
 
       (scheme#list-ref l2 -1)
@@ -964,8 +965,8 @@ Warning: List index negative.
   Calling `list-ref' from module `scheme' with a negative index -1.
 
 Warning: List index negative.
-    (scrutiny-tests.scm:244) 
-    In `list-ref-warn3', a toplevel procedure
+    In file `scrutiny-tests.scm:244',
+    In procedure `list-ref-warn3' (toplevel),
     In procedure call:
 
       (scheme#list-ref l3 -1)
@@ -973,8 +974,8 @@ Warning: List index negative.
   Calling `list-ref' from module `scheme' with a negative index -1.
 
 Warning: List index out of range.
-    (scrutiny-tests.scm:246) 
-    In `list-ref-warn4', a toplevel procedure
+    In file `scrutiny-tests.scm:246',
+    In procedure `list-ref-warn4' (toplevel),
     In procedure call:
 
       (scheme#list-ref l1 3)
@@ -982,8 +983,8 @@ Warning: List index out of range.
   Calling `list-ref' from module `scheme' with index `3' for a list of length 
`3'.
 
 Warning: List index out of range.
-    (scrutiny-tests.scm:252) 
-    In `list-ref-warn5', a toplevel procedure
+    In file `scrutiny-tests.scm:252',
+    In procedure `list-ref-warn5' (toplevel),
     In procedure call:
 
       (scheme#list-ref l1 4)
@@ -991,8 +992,8 @@ Warning: List index out of range.
   Calling `list-ref' from module `scheme' with index `4' for a list of length 
`3'.
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:281) 
-    In `list-ref-standard-warn1', a toplevel procedure
+    In file `scrutiny-tests.scm:281',
+    In procedure `list-ref-standard-warn1' (toplevel),
     In procedure call:
 
       (scheme#list-ref l1 'bad)
@@ -1014,8 +1015,8 @@ Warning: Invalid argument type.
     ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:282) 
-    In `list-ref-standard-warn2', a toplevel procedure
+    In file `scrutiny-tests.scm:282',
+    In procedure `list-ref-standard-warn2' (toplevel),
     In procedure call:
 
       (scheme#list-ref l1 'bad)
@@ -1037,8 +1038,8 @@ Warning: Invalid argument type.
     ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:284) 
-    In `list-ref-standard-warn3', a toplevel procedure
+    In file `scrutiny-tests.scm:284',
+    In procedure `list-ref-standard-warn3' (toplevel),
     In procedure call:
 
       (scheme#list-ref l2 'bad)
@@ -1060,8 +1061,8 @@ Warning: Invalid argument type.
     ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:285) 
-    In `list-ref-standard-warn4', a toplevel procedure
+    In file `scrutiny-tests.scm:285',
+    In procedure `list-ref-standard-warn4' (toplevel),
     In procedure call:
 
       (scheme#list-ref l2 'bad)
@@ -1083,8 +1084,8 @@ Warning: Invalid argument type.
     ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:289) 
-    In `list-ref-type-warn1', a toplevel procedure
+    In file `scrutiny-tests.scm:289',
+    In procedure `list-ref-type-warn1' (toplevel),
     In procedure call:
 
       (chicken.base#add1 (scheme#list-ref l1 1))
@@ -1110,8 +1111,8 @@ Warning: Invalid argument type.
     (number -> number)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:291) 
-    In `list-ref-type-warn2', a toplevel procedure
+    In file `scrutiny-tests.scm:291',
+    In procedure `list-ref-type-warn2' (toplevel),
     In procedure call:
 
       (chicken.base#add1 (scheme#list-ref l2 1))
@@ -1137,8 +1138,8 @@ Warning: Invalid argument type.
     (number -> number)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:295) 
-    In `list-ref-type-warn3', a toplevel procedure
+    In file `scrutiny-tests.scm:295',
+    In procedure `list-ref-type-warn3' (toplevel),
     In procedure call:
 
       (chicken.base#add1 (scheme#list-ref l3 1))
@@ -1164,8 +1165,8 @@ Warning: Invalid argument type.
     (number -> number)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:307) 
-    In `append-result-type-warn1', a toplevel procedure
+    In file `scrutiny-tests.scm:307',
+    In procedure `append-result-type-warn1' (toplevel),
     In procedure call:
 
       (chicken.base#add1 (scheme#list-ref l1 1))
@@ -1191,8 +1192,8 @@ Warning: Invalid argument type.
     (number -> number)
 
 Warning: Invalid argument type.
-    (scrutiny-tests.scm:312) 
-    In `append-result-type-warn2', a toplevel procedure
+    In file `scrutiny-tests.scm:312',
+    In procedure `append-result-type-warn2' (toplevel),
     In procedure call:
 
       (chicken.base#add1 (scheme#list-ref l3 3))
diff --git a/tests/specialization.expected b/tests/specialization.expected
index a2587f1..74fed46 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -1,7 +1,7 @@
 
 Note: Predicate always true.
-    (specialization-tests.scm:3) 
-    At toplevel:
+    In file `specialization-tests.scm:3',
+    At toplevel,
     In predicate call:
 
       (scheme#string? a)
@@ -17,8 +17,8 @@ Note: Predicate always true.
     string
 
 Note: Test always true.
-    (specialization-tests.scm:3) 
-    At toplevel:
+    In file `specialization-tests.scm:3',
+    At toplevel,
     In conditional expression:
 
       (if (scheme#string? a) 'ok 'no)
@@ -28,8 +28,8 @@ Note: Test always true.
     true
 
 Note: Predicate always false.
-    (specialization-tests.scm:4) 
-    At toplevel:
+    In file `specialization-tests.scm:4',
+    At toplevel,
     In predicate call:
 
       (scheme#string? a)
@@ -45,8 +45,8 @@ Note: Predicate always false.
     symbol
 
 Note: Test always false.
-    (specialization-tests.scm:4) 
-    At toplevel:
+    In file `specialization-tests.scm:4',
+    At toplevel,
     In conditional expression:
 
       (if (scheme#string? a) 'ok 'no)
@@ -54,8 +54,8 @@ Note: Test always false.
   Test condition is always false.
 
 Note: Predicate always true.
-    (specialization-tests.scm:10) 
-    At toplevel:
+    In file `specialization-tests.scm:10',
+    At toplevel,
     In predicate call:
 
       (scheme#input-port? p)
@@ -71,8 +71,8 @@ Note: Predicate always true.
     input/output-port
 
 Note: Test always true.
-    (specialization-tests.scm:10) 
-    At toplevel:
+    In file `specialization-tests.scm:10',
+    At toplevel,
     In conditional expression:
 
       (if (scheme#input-port? p) 'ok 'no)
@@ -82,8 +82,8 @@ Note: Test always true.
     true
 
 Note: Predicate always true.
-    (specialization-tests.scm:11) 
-    At toplevel:
+    In file `specialization-tests.scm:11',
+    At toplevel,
     In predicate call:
 
       (scheme#output-port? p)
@@ -99,8 +99,8 @@ Note: Predicate always true.
     input/output-port
 
 Note: Test always true.
-    (specialization-tests.scm:11) 
-    At toplevel:
+    In file `specialization-tests.scm:11',
+    At toplevel,
     In conditional expression:
 
       (if (scheme#output-port? p) 'ok 'no)
-- 
2.7.4

>From e6e7a4d9bdc20a1c476a60e96dedeefa090f9b5a Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Wed, 28 Nov 2018 17:28:03 +0200
Subject: [PATCH 10/12] * tests/runtests.sh: Sanitize gensyms from scrutinizer
 outputs

Instead of skipping tests that are sensitive to gensyms altogether try
to sanitize the output.

* tests/redact-gensyms.scm: New small program to replace numbers from
  common gensym prefixes

* [tests] runtests.sh: compile, use redact-gensyms

+ update *.expected
---
 tests/redact-gensyms.scm                  | 20 ++++++++++++++++++++
 tests/runtests.sh                         | 31 ++++++++++++-------------------
 tests/scrutinizer-message-format.expected |  3 ++-
 tests/scrutiny-2.expected                 |  1 +
 tests/scrutiny.expected                   | 11 ++++++-----
 tests/specialization.expected             |  1 +
 6 files changed, 42 insertions(+), 25 deletions(-)
 create mode 100644 tests/redact-gensyms.scm

diff --git a/tests/redact-gensyms.scm b/tests/redact-gensyms.scm
new file mode 100644
index 0000000..0e4e491
--- /dev/null
+++ b/tests/redact-gensyms.scm
@@ -0,0 +1,20 @@
+(module
+ redact-gensyms
+ ()
+ (import scheme)
+ (import (chicken base))
+ (import (chicken irregex))
+ (import (chicken type))
+ (import (only (chicken io) read-line))
+
+ (define common-gensyms '("tmp" "g"))
+
+ (let ((rege (irregex `(: ($ (or ,@common-gensyms)) (+ numeric)))))
+   (print ";; numbers replaced with XXX by redact-gensyms.scm")
+   (let lp ()
+     (let ((l (read-line)))
+       (if (not (eof-object? l))
+          (begin
+            (print (irregex-replace/all rege l 1 "XXX"))
+            (lp))))))
+ )
diff --git a/tests/runtests.sh b/tests/runtests.sh
index e5e6e3c..6fc6b97 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -114,28 +114,21 @@ $compile typematch-tests.scm -specialize -no-warnings
 
 $compile scrutiny-tests.scm -analyze-only -verbose 2>scrutiny.out
 $compile specialization-tests.scm -analyze-only -verbose -specialize 
2>specialization.out
-
-# these are sensitive to gensym-names, so make them optional
-if test \! -f scrutiny.expected; then
-    cp scrutiny.expected scrutiny.out
-fi
-if test \! -f specialization.expected; then
-    cp specialization.expected specialization.out
-fi
-
 $compile scrutiny-tests-2.scm -A -verbose 2>scrutiny-2.out
 $compile test-scrutinizer-message-format.scm -A -specialize -verbose 
2>scrutinizer-message-format.out || true
 
-diff $DIFF_OPTS scrutinizer-message-format.expected 
scrutinizer-message-format.out
-diff $DIFF_OPTS scrutiny.expected scrutiny.out
-diff $DIFF_OPTS specialization.expected specialization.out
-
-# this is sensitive to gensym-names, so make it optional
-if test \! -f scrutiny-2.expected; then
-    cp scrutiny-2.expected scrutiny-2.out
-fi
-
-diff $DIFF_OPTS scrutiny-2.expected scrutiny-2.out
+# Replace foo123 -> fooXX so gensyms don't trigger failures
+$compile redact-gensyms.scm
+mv a.out redact-gensyms
+./redact-gensyms < scrutinizer-message-format.out > 
scrutinizer-message-format.redacted
+./redact-gensyms < scrutiny-2.out > scrutiny-2.redacted
+./redact-gensyms < scrutiny.out > scrutiny.redacted
+./redact-gensyms < specialization.out > specialization.redacted
+
+diff $DIFF_OPTS scrutinizer-message-format.expected 
scrutinizer-message-format.redacted
+diff $DIFF_OPTS scrutiny-2.expected scrutiny-2.redacted
+diff $DIFF_OPTS scrutiny.expected scrutiny.redacted
+diff $DIFF_OPTS specialization.expected specialization.redacted
 
 $compile scrutiny-tests-3.scm -specialize -block
 ./a.out
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index fbe91f7..728dca5 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -1,3 +1,4 @@
+;; numbers replaced with XXX by redact-gensyms.scm
 
 Warning: literal in operator position: (1 2)
 
@@ -933,7 +934,7 @@ Error: No typecase matches.
     In procedure `fail-compiler-typecase',
     In `compiler-typecase' expression:
 
-      (compiler-typecase g104 (symbol 1) (list 2) (else (##core#undefined)))
+      (compiler-typecase gXXX (symbol 1) (list 2) (else (##core#undefined)))
 
   Tested expression in `compiler-typecase' does not match any case.
 
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index ee42a48..6a7155c 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -1,3 +1,4 @@
+;; numbers replaced with XXX by redact-gensyms.scm
 
 Note: Predicate always true.
     In file `scrutiny-tests-2.scm:20',
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 45d065e..3349510 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -1,3 +1,4 @@
+;; numbers replaced with XXX by redact-gensyms.scm
 
 Warning: (scrutiny-tests.scm:31) - assignment to imported value binding `car'
 
@@ -187,14 +188,14 @@ Warning: Invalid assigned value type.
 
     (Name: scheme#car)
 
-Warning: Let bind to `g19' with 2 values.
+Warning: Let bind to `gXXX' with 2 values.
     In file `scrutiny-tests.scm:33',
     At toplevel,
     In let expression:
 
-      (let ((g19 (scheme#values 1 2))) (g19))
+      (let ((gXXX (scheme#values 1 2))) (gXXX))
 
-  Variable `g19' is bound value from expression that returns 2 values.
+  Variable `gXXX' is bound value from expression that returns 2 values.
 
   The expression is a call to `values' from module `scheme' which has this 
type:
 
@@ -208,9 +209,9 @@ Warning: Invalid procedure.
     At toplevel,
     In procedure call:
 
-      (g19)
+      (gXXX)
 
-  Variable `g1920' is not a procedure.
+  Variable `gXXX' is not a procedure.
 
   It has this type:
 
diff --git a/tests/specialization.expected b/tests/specialization.expected
index 74fed46..8698b85 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -1,3 +1,4 @@
+;; numbers replaced with XXX by redact-gensyms.scm
 
 Note: Predicate always true.
     In file `specialization-tests.scm:3',
-- 
2.7.4

>From 0293e27f374e75e576243d94c0587e760b3da65c Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Sat, 1 Dec 2018 10:24:16 +0200
Subject: [PATCH 11/12] * scrutinizer.scm: Fix renaming issue with 'the'

The 'the macro calls check-and-validate-type which will eventually
call simplify-type on the type. simplify-type renames type variables
with gensym and sets the ##core#real-name property. Finally the 'the
macro expander uses the property to incorrectly undo the renaming.

As a side effect, the type variables in scrutinizer messages are
printed in their full gensym'd glory. This is fixed in a later commit.

Fixes #1563

* scrutinizer.scm (simplify-type): Don't set the ##core#real-name
  property for renamed tvs

* tests/typematch-tests.scm: Add test

* tests/scrutiny.expected: update
---
 scrutinizer.scm                           |  4 +---
 tests/scrutinizer-message-format.expected |  4 ++--
 tests/scrutiny.expected                   | 30 +++++++++++++++---------------
 tests/typematch-tests.scm                 |  2 ++
 4 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 35c3a26..d78796b 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1112,9 +1112,7 @@
                     (set! typeenv
                       (append (map (lambda (v)
                                      (let ((v (if (symbol? v) v (first v))))
-                                       (let ((v* (gensym v)))
-                                         (mark-variable v* '##core#real-name v)
-                                         (cons v v*))))
+                                       (cons v (gensym v))))
                                    typevars)
                               typeenv))
                     (set! constraints 
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index 728dca5..d9ab93e 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -15,7 +15,7 @@ Warning: Wrong number of arguments.
 
   Procedure `cons' from module `scheme' has this type:
 
-    ('a 'b --> (pair 'a 'b))
+    ('a159 'b160 --> (pair 'a159 'b160))
 
 Warning: Invalid argument type.
     In file `test-scrutinizer-message-format.scm:10',
@@ -307,7 +307,7 @@ Warning: Wrong number of arguments.
 
   Procedure `cons' from module `scheme' has this type:
 
-    ('a 'b --> (pair 'a 'b))
+    ('a159 'b160 --> (pair 'a159 'b160))
 
 Warning: Invalid argument type.
     In file `test-scrutinizer-message-format.scm:46',
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 3349510..64ecf66 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -184,7 +184,7 @@ Warning: Invalid assigned value type.
 
   The declared type of `car' from module `scheme' is:
 
-    ((pair 'a *) -> 'a)
+    ((pair 'a335 *) -> 'a335)
 
     (Name: scheme#car)
 
@@ -567,7 +567,7 @@ Warning: Invalid argument type.
 
   Procedure `apply1' has this type:
 
-    ((&rest 'a -> 'b) (list-of 'a) -> 'b)
+    ((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
 
 Warning: Invalid argument type.
     In file `scrutiny-tests.scm:169',
@@ -586,7 +586,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `cons' from module `scheme' which has this type:
 
-    ('a 'b -> (pair 'a 'b))
+    ('a331 'b332 -> (pair 'a331 'b332))
 
   This is the expression:
 
@@ -594,7 +594,7 @@ Warning: Invalid argument type.
 
   Procedure `apply1' has this type:
 
-    ((&rest 'a -> 'b) (list-of 'a) -> 'b)
+    ((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
 
 Note: Predicate always true.
     In file `scrutiny-tests.scm:182',
@@ -837,7 +837,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `cons' from module `scheme' which has this type:
 
-    ('a 'b -> (pair 'a 'b))
+    ('a331 'b332 -> (pair 'a331 'b332))
 
   This is the expression:
 
@@ -895,7 +895,7 @@ Warning: Invalid argument type.
 
   Procedure `vector-ref' from module `scheme' has this type:
 
-    ((vector-of 'a) fixnum -> 'a)
+    ((vector-of 'a384) fixnum -> 'a384)
 
 Warning: Vector index negative.
     In file `scrutiny-tests.scm:227',
@@ -1013,7 +1013,7 @@ Warning: Invalid argument type.
 
   Procedure `list-ref' from module `scheme' has this type:
 
-    ((list-of 'a) fixnum -> 'a)
+    ((list-of 'a366) fixnum -> 'a366)
 
 Warning: Invalid argument type.
     In file `scrutiny-tests.scm:282',
@@ -1036,7 +1036,7 @@ Warning: Invalid argument type.
 
   Procedure `list-ref' from module `scheme' has this type:
 
-    ((list-of 'a) fixnum -> 'a)
+    ((list-of 'a366) fixnum -> 'a366)
 
 Warning: Invalid argument type.
     In file `scrutiny-tests.scm:284',
@@ -1059,7 +1059,7 @@ Warning: Invalid argument type.
 
   Procedure `list-ref' from module `scheme' has this type:
 
-    ((list-of 'a) fixnum -> 'a)
+    ((list-of 'a366) fixnum -> 'a366)
 
 Warning: Invalid argument type.
     In file `scrutiny-tests.scm:285',
@@ -1082,7 +1082,7 @@ Warning: Invalid argument type.
 
   Procedure `list-ref' from module `scheme' has this type:
 
-    ((list-of 'a) fixnum -> 'a)
+    ((list-of 'a366) fixnum -> 'a366)
 
 Warning: Invalid argument type.
     In file `scrutiny-tests.scm:289',
@@ -1101,7 +1101,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `list-ref' from module `scheme' which has this 
type:
 
-    ((list-of 'a) fixnum -> 'a)
+    ((list-of 'a366) fixnum -> 'a366)
 
   This is the expression:
 
@@ -1128,7 +1128,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `list-ref' from module `scheme' which has this 
type:
 
-    ((list-of 'a) fixnum -> 'a)
+    ((list-of 'a366) fixnum -> 'a366)
 
   This is the expression:
 
@@ -1155,7 +1155,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `list-ref' from module `scheme' which has this 
type:
 
-    ((list-of 'a) fixnum -> 'a)
+    ((list-of 'a366) fixnum -> 'a366)
 
   This is the expression:
 
@@ -1182,7 +1182,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `list-ref' from module `scheme' which has this 
type:
 
-    ((list-of 'a) fixnum -> 'a)
+    ((list-of 'a366) fixnum -> 'a366)
 
   This is the expression:
 
@@ -1209,7 +1209,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `list-ref' from module `scheme' which has this 
type:
 
-    ((list-of 'a) fixnum -> 'a)
+    ((list-of 'a366) fixnum -> 'a366)
 
   This is the expression:
 
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index 97b8328..e86ad58 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -399,6 +399,8 @@
   (length a) ; refine (or pair null) with list (= (list-of *))
   (infer list a))
 
+;; Issue #1563
+(compiler-typecase (the (forall (a) a) 1) ((forall (a) (list a)) 'ok))
 
 (assert
  (compiler-typecase 1
-- 
2.7.4

>From 5e5d9ec7c326eb6141a26e01b9e8938a18cc8c15 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Mon, 10 Dec 2018 13:31:32 +0200
Subject: [PATCH 12/12] * scrutinizer.scm (type->pp-string): Strip unnecessary
 renaming detail from type variables

* scrutinizer.scm (type->pp-string): Strip numbers from type variables
  with a bit of irregex magic
---
 scrutinizer.scm                           | 23 +++++++++++++++++++++--
 tests/scrutinizer-message-format.expected |  4 ++--
 tests/scrutiny.expected                   | 30 +++++++++++++++---------------
 3 files changed, 38 insertions(+), 19 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index d78796b..760414c 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -46,7 +46,8 @@
        chicken.port
        chicken.pretty-print
        chicken.string
-       chicken.syntax)
+       chicken.syntax
+       chicken.irregex)
 
 (include "tweaks")
 (include "mini-srfi-1.scm")
@@ -2352,6 +2353,24 @@
 
 (define (type->pp-string t #!optional (proc-name? #t) (bomb? #t))
   (define pname? proc-name?)
+  (define gen-tv-name ;; Generate cleaner names for type variables
+    ;; (forall (a123) a123) -> (forall (a) a)
+    ;; (forall (a123 a456) (pair a123 a456)) -> (forall (a a1) (pair a a1))
+    (let ((seen '()))
+      (define (count p l) (length (filter p l)))
+      (lambda (tv)
+       (let ((mat (irregex-match
+                   '(: ($ (+ alpha)) (+ numeric))
+                   (symbol->string tv))))
+         ;; We expect T to be a validated type => simplify-type
+         ;; should have gensymed tvs
+         (when (not mat) (bomb "tv not renamed" tv t))
+
+         (let* ((var (irregex-match-substring mat 1))
+                (c (count (cut eq? <> var) seen)))
+           (set! seen (cons tv seen))
+           (string->symbol (format "~a~a" var (if (zero? c) "" c))))))))
+
   (define (conv t #!optional (tv-replacements '()))
     (define (R t) (conv t tv-replacements))
     (cond
@@ -2366,7 +2385,7 @@
       (let ((tcar (and (pair? t) (car t))))
        (cond
         ((and (eq? 'forall tcar) (every symbol? (second t))) ;; no constraints
-         (let ((tvs (map (lambda (tv) (cons tv (list 'quote tv))) (second t))))
+         (let ((tvs (map (lambda (tv) (cons tv (list 'quote (gen-tv-name 
tv)))) (second t))))
            (conv (third t) tvs)))
         ((eq? 'forall tcar) t)  ; forall with constraints, do nothing
         ((memq tcar '(or not list vector pair list-of vector-of))
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index d9ab93e..728dca5 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -15,7 +15,7 @@ Warning: Wrong number of arguments.
 
   Procedure `cons' from module `scheme' has this type:
 
-    ('a159 'b160 --> (pair 'a159 'b160))
+    ('a 'b --> (pair 'a 'b))
 
 Warning: Invalid argument type.
     In file `test-scrutinizer-message-format.scm:10',
@@ -307,7 +307,7 @@ Warning: Wrong number of arguments.
 
   Procedure `cons' from module `scheme' has this type:
 
-    ('a159 'b160 --> (pair 'a159 'b160))
+    ('a 'b --> (pair 'a 'b))
 
 Warning: Invalid argument type.
     In file `test-scrutinizer-message-format.scm:46',
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 64ecf66..3349510 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -184,7 +184,7 @@ Warning: Invalid assigned value type.
 
   The declared type of `car' from module `scheme' is:
 
-    ((pair 'a335 *) -> 'a335)
+    ((pair 'a *) -> 'a)
 
     (Name: scheme#car)
 
@@ -567,7 +567,7 @@ Warning: Invalid argument type.
 
   Procedure `apply1' has this type:
 
-    ((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
+    ((&rest 'a -> 'b) (list-of 'a) -> 'b)
 
 Warning: Invalid argument type.
     In file `scrutiny-tests.scm:169',
@@ -586,7 +586,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `cons' from module `scheme' which has this type:
 
-    ('a331 'b332 -> (pair 'a331 'b332))
+    ('a 'b -> (pair 'a 'b))
 
   This is the expression:
 
@@ -594,7 +594,7 @@ Warning: Invalid argument type.
 
   Procedure `apply1' has this type:
 
-    ((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
+    ((&rest 'a -> 'b) (list-of 'a) -> 'b)
 
 Note: Predicate always true.
     In file `scrutiny-tests.scm:182',
@@ -837,7 +837,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `cons' from module `scheme' which has this type:
 
-    ('a331 'b332 -> (pair 'a331 'b332))
+    ('a 'b -> (pair 'a 'b))
 
   This is the expression:
 
@@ -895,7 +895,7 @@ Warning: Invalid argument type.
 
   Procedure `vector-ref' from module `scheme' has this type:
 
-    ((vector-of 'a384) fixnum -> 'a384)
+    ((vector-of 'a) fixnum -> 'a)
 
 Warning: Vector index negative.
     In file `scrutiny-tests.scm:227',
@@ -1013,7 +1013,7 @@ Warning: Invalid argument type.
 
   Procedure `list-ref' from module `scheme' has this type:
 
-    ((list-of 'a366) fixnum -> 'a366)
+    ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
     In file `scrutiny-tests.scm:282',
@@ -1036,7 +1036,7 @@ Warning: Invalid argument type.
 
   Procedure `list-ref' from module `scheme' has this type:
 
-    ((list-of 'a366) fixnum -> 'a366)
+    ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
     In file `scrutiny-tests.scm:284',
@@ -1059,7 +1059,7 @@ Warning: Invalid argument type.
 
   Procedure `list-ref' from module `scheme' has this type:
 
-    ((list-of 'a366) fixnum -> 'a366)
+    ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
     In file `scrutiny-tests.scm:285',
@@ -1082,7 +1082,7 @@ Warning: Invalid argument type.
 
   Procedure `list-ref' from module `scheme' has this type:
 
-    ((list-of 'a366) fixnum -> 'a366)
+    ((list-of 'a) fixnum -> 'a)
 
 Warning: Invalid argument type.
     In file `scrutiny-tests.scm:289',
@@ -1101,7 +1101,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `list-ref' from module `scheme' which has this 
type:
 
-    ((list-of 'a366) fixnum -> 'a366)
+    ((list-of 'a) fixnum -> 'a)
 
   This is the expression:
 
@@ -1128,7 +1128,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `list-ref' from module `scheme' which has this 
type:
 
-    ((list-of 'a366) fixnum -> 'a366)
+    ((list-of 'a) fixnum -> 'a)
 
   This is the expression:
 
@@ -1155,7 +1155,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `list-ref' from module `scheme' which has this 
type:
 
-    ((list-of 'a366) fixnum -> 'a366)
+    ((list-of 'a) fixnum -> 'a)
 
   This is the expression:
 
@@ -1182,7 +1182,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `list-ref' from module `scheme' which has this 
type:
 
-    ((list-of 'a366) fixnum -> 'a366)
+    ((list-of 'a) fixnum -> 'a)
 
   This is the expression:
 
@@ -1209,7 +1209,7 @@ Warning: Invalid argument type.
 
   The expression is a call to `list-ref' from module `scheme' which has this 
type:
 
-    ((list-of 'a366) fixnum -> 'a366)
+    ((list-of 'a) fixnum -> 'a)
 
   This is the expression:
 
-- 
2.7.4


reply via email to

[Prev in Thread] Current Thread [Next in Thread]