diff options
| -rw-r--r-- | am/guilec | 2 | ||||
| -rw-r--r-- | module/ice-9/boot-9.scm | 4 | ||||
| -rw-r--r-- | module/language/tree-il/analyze.scm | 70 | ||||
| -rw-r--r-- | module/language/tree-il/compile-cps.scm | 11 | ||||
| -rw-r--r-- | module/system/base/message.scm | 6 |
5 files changed, 81 insertions, 12 deletions
@@ -1,7 +1,7 @@ # -*- makefile -*- GOBJECTS = $(SOURCES:%.scm=%.go) $(ELISP_SOURCES:%.el=%.go) -GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +GUILE_WARNINGS = -Wunbound-variable -Wmacro-use-before-definition -Warity-mismatch -Wformat moddir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/$(modpath) nobase_mod_DATA = $(SOURCES) $(ELISP_SOURCES) $(NOCOMP_SOURCES) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index c2ee108f6..99543e7a5 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -3679,8 +3679,8 @@ but it fails to load." (define %auto-compilation-options ;; Default `compile-file' option when auto-compiling. - '(#:warnings (unbound-variable arity-mismatch format - duplicate-case-datum bad-case-datum))) + '(#:warnings (unbound-variable macro-use-before-definition arity-mismatch + format duplicate-case-datum bad-case-datum))) (define* (load-in-vicinity dir file-name #:optional reader) "Load source file FILE-NAME in vicinity of directory DIR. Use a diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm index 1c0612764..ff4b93d31 100644 --- a/module/language/tree-il/analyze.scm +++ b/module/language/tree-il/analyze.scm @@ -35,6 +35,7 @@ unused-variable-analysis unused-toplevel-analysis unbound-variable-analysis + macro-use-before-definition-analysis arity-analysis format-analysis)) @@ -895,16 +896,77 @@ given `tree-il' element." (lambda (toplevel env) ;; Post-process the result. - (vlist-for-each (lambda (name+loc) - (let ((name (car name+loc)) - (loc (cdr name+loc))) - (warning 'unbound-variable loc name))) + (vlist-for-each (match-lambda + ((name . loc) + (warning 'unbound-variable loc name))) (vlist-reverse (toplevel-info-refs toplevel)))) (make-toplevel-info vlist-null vlist-null))) ;;; +;;; Macro use-before-definition analysis. +;;; + +;; <macro-use-info> records are used during tree traversal in search of +;; possibly uses of macros before they are defined. They contain a list +;; of references to top-level variables, and a list of the top-level +;; macro definitions that have been encountered. Any definition which +;; is a macro should in theory be expanded out already; if that's not +;; the case, the program likely has a bug. +(define-record-type <macro-use-info> + (make-macro-use-info uses defs) + macro-use-info? + (uses macro-use-info-uses) ;; ((VARIABLE-NAME . LOCATION) ...) + (defs macro-use-info-defs)) ;; ((VARIABLE-NAME . LOCATION) ...) + +(define macro-use-before-definition-analysis + ;; Report possibly unbound variables in the given tree. + (make-tree-analysis + (lambda (x info env locs) + ;; Going down into X. + (define (nearest-loc src) + (or src (find pair? locs))) + (define (add-use name src) + (match info + (($ <macro-use-info> uses defs) + (make-macro-use-info (vhash-consq name src uses) defs)))) + (define (add-def name src) + (match info + (($ <macro-use-info> uses defs) + (make-macro-use-info uses (vhash-consq name src defs))))) + (define (macro? x) + (match x + (($ <primcall> _ 'make-syntax-transformer) #t) + (_ #f))) + (match x + (($ <toplevel-ref> src name) + (add-use name (nearest-loc src))) + (($ <toplevel-set> src name) + (add-use name (nearest-loc src))) + (($ <toplevel-define> src name (? macro?)) + (add-def name (nearest-loc src))) + (_ info))) + + (lambda (x info env locs) + ;; Leaving X's scope. + info) + + (lambda (info env) + ;; Post-process the result. + (match info + (($ <macro-use-info> uses defs) + (vlist-for-each + (match-lambda + ((name . use-loc) + (when (vhash-assq name defs) + (warning 'macro-use-before-definition use-loc name)))) + (vlist-reverse (macro-use-info-uses info)))))) + + (make-macro-use-info vlist-null vlist-null))) + + +;;; ;;; Arity analysis. ;;; diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm index 3443d761e..9e7dc72ca 100644 --- a/module/language/tree-il/compile-cps.scm +++ b/module/language/tree-il/compile-cps.scm @@ -955,11 +955,12 @@ integer." (define *comp-module* (make-fluid)) (define %warning-passes - `((unused-variable . ,unused-variable-analysis) - (unused-toplevel . ,unused-toplevel-analysis) - (unbound-variable . ,unbound-variable-analysis) - (arity-mismatch . ,arity-analysis) - (format . ,format-analysis))) + `((unused-variable . ,unused-variable-analysis) + (unused-toplevel . ,unused-toplevel-analysis) + (unbound-variable . ,unbound-variable-analysis) + (macro-use-before-definition . ,macro-use-before-definition-analysis) + (arity-mismatch . ,arity-analysis) + (format . ,format-analysis))) (define (optimize-tree-il x e opts) (define warnings diff --git a/module/system/base/message.scm b/module/system/base/message.scm index 26d1a181a..979291c1e 100644 --- a/module/system/base/message.scm +++ b/module/system/base/message.scm @@ -115,6 +115,12 @@ (emit port "~A: warning: possibly unbound variable `~A'~%" loc name))) + (macro-use-before-definition + "report possibly mis-use of macros before they are defined" + ,(lambda (port loc name) + (emit port "~A: warning: macro `~A' used before definition~%" + loc name))) + (arity-mismatch "report procedure arity mismatches (wrong number of arguments)" ,(lambda (port loc name certain?) |