mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Add compiler warning for possibly unbound variables.

Browse source 
* module/language/tree-il/analyze.scm (<toplevel-info>): New record
  type.
  (env-module, report-possibly-unbound-variables): New procedures.

* module/language/tree-il/compile-glil.scm (%warning-passes): Add
  `unbound-variable'.

* module/system/base/message.scm (%warning-types): Likewise.

* test-suite/tests/tree-il.test (read-and-compile, %opts-w-unbound):
  New.
  ("warnings")["unbound variable"]: New test prefix.
This commit is contained in:
Ludovic Courtès 2009-10-06 23:39:56 +02:00
parent 43eb8acada
commit f67ddf9dbf
4 changed files with 171 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

100
module/language/tree-il/analyze.scm
View file

@ -24,8 +24,11 @@
#:use-module (system base syntax)
#:use-module (system base message)
#:use-module (language tree-il)
#:use-module ((system base compile)
#:select (current-compilation-environment))
#:export (analyze-lexicals
report-unused-variables))
report-unused-variables
report-possibly-unbound-variables))
;; Allocation is the process of assigning storage locations for lexical
;; variables. A lexical variable has a distinct "address", or storage
@ -615,3 +618,98 @@
(make-binding-info '() '() '())
tree)
tree)
;;;
;;; Unbound variable analysis.
;;;
;; <toplevel-info> records are used during tree traversal in search of
;; possibly unbound variable. They contain a list of references to
;; potentially unbound top-level variables, a list of the top-level defines
;; that have been encountered, and a "location stack" (see above).
(define-record-type <toplevel-info>
(make-toplevel-info refs defs locs)
toplevel-info?
(refs toplevel-info-refs) ;; ((VARIABLE-NAME . LOCATION) ...)
(defs toplevel-info-defs) ;; (VARIABLE-NAME ...)
(locs toplevel-info-locs)) ;; (LOCATION ...)
(define (env-module e)
"Return the module corresponding to E."
;; XXX: This is a bit of a hack since since representation of compile-time
;; environments is hidden in `(language scheme compile-tree-il)'.
(cond ((pair? e) (car e))
((module? e) e)
(else (current-compilation-environment))))
;; TODO: Combine with `report-unused-variables' so we don't traverse the tree
;; once for each warning type.
(define (report-possibly-unbound-variables tree env)
"Return possibly unbound variables in TREE. Return TREE."
(define toplevel
(let ((env (env-module env)))
(tree-il-fold (lambda (x info)
;; X is a leaf: extend INFO's refs accordingly.
(let ((refs (toplevel-info-refs info))
(defs (toplevel-info-defs info))
(locs (toplevel-info-locs info)))
(define (bound? name)
(or (and (module? env)
(module-variable env name))
(memq name defs)))
(record-case x
((<toplevel-ref> name src)
(if (bound? name)
info
(let ((src (or src (find pair? locs))))
(make-toplevel-info (alist-cons name src refs)
defs
locs))))
(else info))))
(lambda (x info)
;; Going down into X.
(let* ((refs (toplevel-info-refs info))
(defs (toplevel-info-defs info))
(src (tree-il-src x))
(locs (cons src (toplevel-info-locs info))))
(define (bound? name)
(or (and (module? env)
(module-variable env name))
(memq name defs)))
(record-case x
((<toplevel-set> name src)
(if (bound? name)
(make-toplevel-info refs defs locs)
(let ((src (find pair? locs)))
(make-toplevel-info (alist-cons name src refs)
defs
locs))))
((<toplevel-define> name)
(make-toplevel-info (alist-delete name refs eq?)
(cons name defs)
locs))
(else
(make-toplevel-info refs defs locs)))))
(lambda (x info)
;; Leaving X's scope.
(let ((refs (toplevel-info-refs info))
(defs (toplevel-info-defs info))
(locs (toplevel-info-locs info)))
(make-toplevel-info refs defs (cdr locs))))
(make-toplevel-info '() '() '())
tree)))
(for-each (lambda (name+loc)
(let ((name (car name+loc))
(loc (cdr name+loc)))
(warning 'unbound-variable loc name)))
(reverse (toplevel-info-refs toplevel)))
tree)

3
module/language/tree-il/compile-glil.scm
View file

@ -46,7 +46,8 @@
(define *comp-module* (make-fluid))
(define %warning-passes
`((unused-variable . ,report-unused-variables)))
`((unused-variable . ,report-unused-variables)
(unbound-variable . ,report-possibly-unbound-variables)))
(define (compile-glil x e opts)
(define warnings

6
module/system/base/message.scm
View file

@ -79,6 +79,12 @@
"report unused variables"
,(lambda (port loc name)
(format port "~A: warning: unused variable `~A'~%"
loc name)))
(unbound-variable
"report possibly unbound variables"
,(lambda (port loc name)
(format port "~A: warning: possibly unbound variable `~A'~%"
loc name))))))
(define (lookup-warning-type name)

65
test-suite/tests/tree-il.test
View file

@ -26,6 +26,9 @@
#:use-module (language glil)
#:use-module (srfi srfi-13))
(define read-and-compile
(@@ (system base compile) read-and-compile))
;; Of course, the GLIL that is emitted depends on the source info of the
;; input. Here we're not concerned about that, so we strip source
;; information from the incoming tree-il.
@ -535,6 +538,8 @@
(define %opts-w-unused
'(#:warnings (unused-variable)))
(define %opts-w-unbound
'(#:warnings (unbound-variable)))
(with-test-prefix "warnings"
@ -588,4 +593,62 @@
(null? (call-with-warnings
(lambda ()
(compile '(lambda (x y z) #t)
#:opts %opts-w-unused)))))))
#:opts %opts-w-unused))))))
(with-test-prefix "unbound variable"
(pass-if "quiet"
(null? (call-with-warnings
(lambda ()
(compile '+ #:opts %opts-w-unbound)))))
(pass-if "ref"
(let* ((v (gensym))
(w (call-with-warnings
(lambda ()
(compile v
#:to 'assembly
#:opts %opts-w-unbound)))))
(and (= (length w) 1)
(number? (string-contains (car w)
(format #f "unbound variable `~A'"
v))))))
(pass-if "set!"
(let* ((v (gensym))
(w (call-with-warnings
(lambda ()
(compile `(set! ,v 7)
#:to 'assembly
#:opts %opts-w-unbound)))))
(and (= (length w) 1)
(number? (string-contains (car w)
(format #f "unbound variable `~A'"
v))))))
(pass-if "module-local top-level is visible"
(let ((m (make-module))
(v (gensym)))
(beautify-user-module! m)
(compile `(define ,v 123)
#:env m #:opts %opts-w-unbound)
(null? (call-with-warnings
(lambda ()
(compile v
#:env m
#:to 'assembly
#:opts %opts-w-unbound))))))
(pass-if "module-local top-level is visible after"
(let ((m (make-module))
(v (gensym)))
(beautify-user-module! m)
(null? (call-with-warnings
(lambda ()
(let ((in (open-input-string
"(define (f)
(set! chbouib 3))
(define chbouib 5)")))
(read-and-compile in
#:env m
#:opts %opts-w-unbound)))))))))