summaryrefslogtreecommitdiff
path: root/module/language/tree-il/analyze.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/language/tree-il/analyze.scm')
-rw-r--r--module/language/tree-il/analyze.scm119
1 files changed, 55 insertions, 64 deletions
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 46e467791..42ad74d7d 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -633,76 +633,67 @@
(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-module))))
-
;; 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)))
+ (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))