>From e7db0e600e2331ce2031d4090cc20028422e9f06 Mon Sep 17 00:00:00 2001 From: megane 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+)) ) Signed-off-by: Evan Hanson --- core.scm | 13 +++---- modules.scm | 108 ++++++++++++++++++++++++++++++++++------------------ 2 files changed, 78 insertions(+), 43 deletions(-) diff --git a/core.scm b/core.scm index cdfbefa2..8d459702 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) @@ -682,9 +682,9 @@ ,(walk (cadddr x) e dest ldest h ln tl?))) ((##core#local-specialization) - (let* ((name (resolve-variable (cadr x) e dest ldest h)) + (let* ((name (resolve-variable (cadr x) e dest ldest h outer-ln)) (raw-alias (caddr x)) - (resolved-alias (resolve-variable raw-alias e dest ldest h)) + (resolved-alias (resolve-variable raw-alias e dest ldest h outer-ln)) (specs (##sys#get name '##compiler#local-specializations '()))) (letrec ((resolve-alias (lambda (form) (cond ((pair? form) (cons (resolve-alias (car form)) (resolve-alias (cdr form)))) @@ -798,8 +798,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 4f9b507b..cecd4f02 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") @@ -456,10 +458,67 @@ (define ##sys#finalize-module (let ((display display) (write-char write-char)) + ;; 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. (lambda (mod #!optional (invalid-export (lambda _ #f))) - ;; 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. + + ;; Given a list of ( . ), builds a nicely + ;; formatted error message with suggestions where possible. + (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))))) + + (for-each + (lambda (id.locs) + (fprintf out "\n\n Unknown identifier `~a'" (car id.locs)) + + ;; Print all source locations where this ID occurs + (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) (cdr loc)) => + (lambda (ln) + (format "In procedure `~a' on line ~a" (car loc) (ln->num ln)))) + ((and (pair? loc) (cdr loc)) + (format "On line ~a" (ln->num (cdr loc)))) + (else (format "In procedure `~a'" loc))))) + (fprintf out "\n ~a" loc-s))) + (reverse (cdr id.locs))) + + ;; Print suggestions from identifier db + (and-let* ((id (car id.locs)) + (a (getp id '##core#db))) + (fprintf out "\n Suggestion: 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 +570,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.29.3