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

Adjust unbound-variable' GOOPS heuristic for goops.scm'.

Browse source 
* module/language/tree-il/analyze.scm (goops-toplevel-definition): Add
  ENV argument.  Deal with GOOPS macros expanded within `goops.scm'.
  (report-possibly-unbound-variables): Adjust.
This commit is contained in:
Ludovic Courtès 2009-10-22 22:33:53 +02:00
parent 3c365b8efc
commit 6bb891dc61
1 changed files with 17 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -633,21 +633,29 @@
(defs toplevel-info-defs) ;; (VARIABLE-NAME ...)
(locs toplevel-info-locs)) ;; (LOCATION ...)
(define (goops-toplevel-definition proc args)
(define (goops-toplevel-definition proc args env)
;; If application of PROC to ARGS is a GOOPS top-level definition, return
;; the name of the variable being defined; otherwise return #f. This
;; assumes knowledge of the current implementation of `define-class' et al.
(define (toplevel-define-arg args)
(and (pair? args) (pair? (cdr args)) (null? (cddr args))
(record-case (car args)
((<const> exp)
(and (symbol? exp) exp))
(else #f))))
(record-case proc
((<module-ref> mod public? name)
(and (equal? mod '(oop goops))
(not public?)
(eq? name 'toplevel-define!)
(pair? args) (pair? (cdr args)) (null? (cddr args))
(record-case (car args)
((<const> exp)
(and (symbol? exp)
exp))
(else #f))))
(toplevel-define-arg args)))
((<toplevel-ref> name)
;; This may be the result of expanding one of the GOOPS macros within
;; `oop/goops.scm'.
(and (eq? name 'toplevel-define!)
(eq? env (resolve-module '(oop goops)))
(toplevel-define-arg args)))
(else #f)))
;; TODO: Combine with `report-unused-variables' so we don't traverse the tree
@ -703,7 +711,8 @@
((<application> proc args)
;; Check for a dynamic top-level definition, as is
;; done by code expanded from GOOPS macros.
(let ((name (goops-toplevel-definition proc args)))
(let ((name (goops-toplevel-definition proc args
env)))
(if (symbol? name)
(make-toplevel-info (alist-delete name refs
eq?)