[PATCH] Report more information for unresolved identifiers in modules

[megane]

Hi,

here is some improvements for unknown identifier messages.

>From 235e7641362657711702f4905a9dc28aa740ff1e Mon Sep 17 00:00:00 2001
From: megane <meganeka@gmail.com>
Date: Fri, 9 Apr 2021 17:04:52 +0300
Subject: [PATCH] Report more information for unresolved identifiers in modules

The new format gives more clues to resolve unresolved identifiers
warnings. Especially compare the messages for 'last' below.

Given this input:

    (module
     mod () (import scheme)

     (define-syntax mac
       (ir-macro-transformer
        (lambda (e i c)
          `(last))))

     (define (foo)
       (+ bar)
       (lambda ()
         (mac)
         (+ baz))
       (+ fx+)
       (lambda ()
         (+ baz)
         (mac)))

     (define (quux)
       (+ fx+))
     )

--- Before

    Warning: reference to possibly unbound identifier `bar' in:
    Warning:    foo

    Warning: reference to possibly unbound identifier `last'
    Warning:    suggesting: `(import srfi-1)'

    Warning: reference to possibly unbound identifier `baz'

    Warning: reference to possibly unbound identifier `fx+' in:
    Warning:    quux
    Warning:    foo
    Warning:    suggesting: `(import chicken.fixnum)'

    Error: module unresolved: mod

--- After:

    Error: Module `mod' has unresolved identifiers
      In file `../unbound-iden-warnings.scm'

      Unknown identifier `bar'
        in procedure `foo', line 10
      Unknown identifier `last'
        on line 12
        on line 17

        Hint: Try importing module `srfi-1'
      Unknown identifier `baz'
        on line 13
        on line 16
      Unknown identifier `fx+'
        in procedure `foo', line 14
        in procedure `quux', line 20

        Hint: Try importing module `chicken.fixnum'
---
 core.scm    |  9 +++--
 modules.scm | 99 +++++++++++++++++++++++++++++++++++------------------
 2 files changed, 70 insertions(+), 38 deletions(-)

diff --git a/core.scm b/core.scm
index fa19c354..bdef4c58 100644
--- a/core.scm
+++ b/core.scm
@@ -565,7 +565,7 @@
        (cadr x)
        x) )
 
-  (define (resolve-variable x0 e dest ldest h)
+  (define (resolve-variable x0 e dest ldest h outer-ln)
     (when (memq x0 unlikely-variables)
       (warning
        (sprintf "reference to variable `~s' possibly unintended" x0) ))
@@ -596,7 +596,7 @@
                      (finish-foreign-result ft body)
                      t)
                     e dest ldest h #f #f))))
-           ((not (memq x e)) (##sys#alias-global-hook x #f h)) ; only if global
+           ((not (memq x e)) (##sys#alias-global-hook x #f (cons h outer-ln))) 
; only if global
             ((assq x forbidden-refs) =>
              (lambda (a)
                (let ((ln (cdr a)))
@@ -631,7 +631,7 @@
 
   (define (walk x e dest ldest h outer-ln tl?)
     (cond ((keyword? x) `(quote ,x))
-         ((symbol? x) (resolve-variable x e dest ldest h))
+         ((symbol? x) (resolve-variable x e dest ldest h outer-ln))
          ((not (pair? x))
           (if (constant? x)
               `(quote ,x)
@@ -786,8 +786,7 @@
                         ((##core#with-forbidden-refs)
                          (let* ((loc (caddr x))
                                 (vars (map (lambda (v)
-                                             (cons (resolve-variable v e dest
-                                                                     ldest h) 
+                                             (cons (resolve-variable v e dest 
ldest h outer-ln)
                                                    loc))
                                         (cadr x))))
                            (fluid-let ((forbidden-refs 
diff --git a/modules.scm b/modules.scm
index 29fb92e5..2f83bbc2 100644
--- a/modules.scm
+++ b/modules.scm
@@ -42,7 +42,9 @@
        chicken.internal
        chicken.keyword
        chicken.platform
-       chicken.syntax)
+       chicken.syntax
+       (only chicken.string string-split)
+       (only chicken.format fprintf format))
 
 (include "common-declarations.scm")
 (include "mini-srfi-1.scm")
@@ -460,6 +462,60 @@
       ;; invalid-export: Returns a string if given identifier names a
       ;; non-exportable object. The string names the type (e.g. "an
       ;; inline function"). Returns #f otherwise.
+
+      (define (report-unresolved-identifiers unknowns)
+       (let ((out (open-output-string)))
+         (fprintf out "Module `~a' has unresolved identifiers" (module-name 
mod))
+
+         ;; Print filename from a line number entry
+         (let lp ((locs (apply append (map cdr unknowns))))
+           (unless (null? locs)
+             (or (and-let* ((loc (car locs))
+                            (ln (and (pair? loc) (cdr loc)))
+                            (ss (string-split ln ":"))
+                            ((= 2 (length ss))))
+                   (fprintf out "\n  In file `~a'" (car ss))
+                   #t)
+                 (lp (cdr locs)))))
+
+         (newline out)
+         (for-each
+          (lambda (id.locs)
+            (fprintf out "\n  Unknown identifier `~a'" (car id.locs))
+
+            (for-each
+             (lambda (loc)
+               (define (ln->num ln) (let ((ss (string-split ln ":")))
+                                      (if (and (pair? ss) (= 2 (length ss)))
+                                          (cadr ss)
+                                          ln)))
+               (and-let* ((loc-s
+                           (cond
+                            ((and (pair? loc) (car loc))
+                             (or (and-let* ((ln (cdr loc)))
+                                   (format "in procedure `~a', line ~a" (car 
loc) (ln->num ln)))
+                                 (format "in procedure `~a'" (car loc))))
+                            ((and (pair? loc) (cdr loc))
+                             (format "on line ~a" (ln->num (cdr loc))))
+                            [else (format "in2 procedure `~a'" loc)])))
+                 (fprintf out "\n    ~a" loc-s)))
+             (reverse (cdr id.locs)))
+
+            (and-let* ((id (car id.locs))
+                       (a (getp id '##core#db)))
+              (fprintf out "\n\n    Hint: Try importing ")
+              (cond
+               ((= 1 (length a))
+                (fprintf out "module `~a'" (cadar a)))
+               (else
+                (fprintf out "one of these modules:")
+                (for-each
+                 (lambda (a)
+                   (fprintf out "\n       ~a" (cadr a)))
+                 a)))))
+          unknowns)
+
+         (##sys#error (get-output-string out))))
       (let* ((explist (module-export-list mod))
             (name (module-name mod))
             (dlist (module-defined-list mod))
@@ -511,38 +567,15 @@
                                                        " has not been 
defined.")))
                                                 (else (bomb "fail")))))))
                               (loop (cdr xl))))))))))
-        (for-each
-        (lambda (u)
-          (let* ((where (cdr u))
-                 (u (car u)))
-            (unless (memq u elist)
-              (let ((out (open-output-string)))
-                (set! missing #t)
-                (display "reference to possibly unbound identifier `" out)
-                (display u out)
-                (write-char #\' out)
-                (when (pair? where)
-                  (display " in:" out)
-                  (for-each
-                   (lambda (sym)
-                     (display "\nWarning:    " out)
-                     (display sym out))
-                   where))
-                (and-let* ((a (getp u '##core#db)))
-                  (cond ((= 1 (length a))
-                         (display "\nWarning:    suggesting: `(import " out)
-                         (display (cadar a) out)
-                         (display ")'" out))
-                        (else
-                         (display "\nWarning:    suggesting one of:" out)
-                         (for-each
-                          (lambda (a)
-                            (display "\nWarning:    (import " out)
-                            (display (cadr a) out)
-                            (write-char #\) out))
-                          a))))
-                (##sys#warn (get-output-string out))))))
-        (reverse (module-undefined-list mod)))
+
+       ;; Check all identifiers were resolved
+       (let ((unknowns '()))
+         (for-each (lambda (u) (unless (memq (car u) elist)
+                            (set! unknowns (cons u unknowns))))
+                   (module-undefined-list mod))
+         (unless (null? unknowns)
+           (report-unresolved-identifiers unknowns)))
+
        (when missing
          (##sys#error "module unresolved" name))
        (let* ((iexports 
-- 
2.17.1