contain a list of references to top-level variables, and a list of
;;; the top-level 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 <use-before-def-info>
  (make-use-before-def-info depth uses defs)
  use-before-def-info?
  ;; LOCAL-DEF := #(MACRO? DEPTH LOCATION)
  ;; DEF := LOCAL-DEF           ; Defined in compilation unit already at use.
  ;;      | import              ; Def provided by imported module.
  ;;      | unknown-module      ; Module at use site not known.
  ;;      | unknown-declarative ; Defined, but def not within compilation unit.
  ;;      | unknown-imperative  ; Same as above, but in non-declarative module.
  ;;      | unbound             ; No top-level definition known at use
  ;; USE := #(MOD-NAME VAR-NAME DEPTH DEF LOCATION)
  (depth use-before-def-info-depth) ;; Zero if definitely evaluated
  (uses  use-before-def-info-uses)  ;; List of USE
  (defs  use-before-def-info-defs))  ;; Vhash of ((MOD . NAME) . LOCAL-DEF)

(define (goops-toplevel-definition proc args env)
  ;; If call 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.
  (match (cons proc args)
    ((($ <module-ref> _ '(oop goops) 'toplevel-define! #f)
      ($ <const> _ (? symbol? name))
      exp)
     ;; We don't know the precise module in which we are defining the
     ;; variable :/  Guess that it's in `env'.
     (vector (module-name env) name exp))
    ((($ <toplevel-ref> _ '(oop goops) 'toplevel-define!)
      ($ <const> _ (? symbol? name))
      exp)
     (vector '(oop goops) name exp))
    (_ #f)))

(define* (make-use-before-definition-analysis #:key (warning-level 0)
                                              (enabled-warnings '()))
  ;; Report possibly unbound variables in the given tree.
  (define (enabled-for-level? level) (<= level warning-level))
  (define-syntax-rule (define-warning enabled
                        #:level level #:name warning-name)
    (define enabled
      (or (enabled-for-level? level)
          (memq 'warning-name enabled-warnings))))
  (define-warning use-before-definition-enabled
    #:level 1 #:name use-before-definition)
  (define-warning unbound-variable-enabled
    #:level 1 #:name unbound-variable)
  (define-warning macro-use-before-definition-enabled
    #:level 1 #:name macro-use-before-definition)
  (define-warning non-idempotent-definition-enabled
    #:level 1 #:name non-idempotent-definition)
  (define (resolve mod name defs)
    (match (vhash-assoc (cons mod name) defs)
      ((_ . local-def)
       ;; Top-level def present in this compilation unit, before this
       ;; use.
       local-def)
      (#f
       (let ((mod (and mod (resolve-module mod #f #:ensure #f))))
         (cond
          ((not mod)
           ;; We don't know the module with respect to which this var
           ;; is being resolved.
           'unknown-module)
          ((module-local-variable mod name)
           ;; The variable is locally bound in the module, but not by
           ;; any definition in the compilation unit; perhaps by load
           ;; or load-extension or something.
           (if (module-declarative? mod)
               'unknown-declarative
               'unknown-imperative))
          ((module-variable mod name)
           ;; The variable is an import.  At the time of use, the
           ;; name is bound to the import.
           'import)
          ((and=> (module-public-interface mod)
                  (lambda (interface)
                    (module-variable interface name)))
           ;; The variable is re-exported from another module.
           'import)
          (else
           ;; Variable unbound in the module.
           'unbound))))))

  (and
   (or use-before-definition-enabled
       unbound-variable-enabled
       macro-use-before-definition-enabled
       non-idempotent-definition-enabled)
   (make-tree-analysis
    (lambda (x info env locs)
      ;; Going down into X.
      (define (make-use mod name depth def src)
        (vector mod name depth def src))
      (define (make-def is-macro? depth src)
        (vector is-macro? depth src))
      (define (nearest-loc src)
        (or src (find pair? locs)))
      (define (add-use mod name src)
        (match info
          (($ <use-before-def-info> depth uses defs)
           (let* ((def (resolve mod name defs))
                  (use (make-use mod name depth def src)))
             (make-use-before-def-info depth (cons use uses) defs)))))
      (define (add-def mod name src is-macro?)
        (match info
          (($ <use-before-def-info> depth uses defs)
           (let ((def (make-def is-macro? depth src)))
             (make-use-before-def-info depth uses
                                       (vhash-cons (cons mod name) def
                                                   defs))))))
      (define (macro? x)
        (match x
          (($ <primcall> _ 'make-syntax-transformer) #t)
          (_ #f)))
      (match x
        (($ <toplevel-ref> src mod name)
         (add-use mod name (nearest-loc src)))
        (($ <toplevel-set> src mod name)
         (add-use mod name (nearest-loc src)))
        (($ <toplevel-define> src mod name exp)
         (add-def mod name (nearest-loc src) (macro? exp)))
        (($ <call> src proc args)
         ;; Check for a dynamic top-level definition, as is
         ;; done by code expanded from GOOPS macros.
         (match (goops-toplevel-definition proc args env)
           (#f info)
           (#(mod name exp) (add-def mod name (nearest-loc src) (macro? exp)))))
        ((or ($ <lambda>) ($ <conditional>))
         (match info
           (($ <use-before-def-info> depth uses defs)
            (make-use-before-def-info (1+ depth) uses defs))))
        (_ info)))

    (lambda (x info env locs)
      ;; Leaving X's scope.
      (match x
        ((or ($ <lambda>) ($ <conditional>))
         (match info
           (($ <use-before-def-info> depth uses defs)
            (make-use-before-def-info (1- depth) uses defs))))
        (_ info)))

    (lambda (info env)
      (define (compute-macros defs)
        (let ((macros (make-hash-table)))
          (vlist-for-each (match-lambda
                           ((mod+name . #(is-macro? depth src))
                            (when is-macro?
                              (hash-set! macros mod+name src))))
                          defs)
          macros))
      ;; Post-process the result.
      ;; FIXME: What to do with defs at nonzero depth?
      (match info
        (($ <use-before-def-info> 0 uses defs)
         ;; The way the traversal works is that we only add entries to
         ;; `defs' as we go, corresponding to local bindings.
         ;; Therefore the result of `resolve' can only go from being an
         ;; import, unbound, or top-level definition to being a
         ;; definition within the compilation unit.  It can't go from
         ;; e.g. being an import to being a top-level definition, for
         ;; the purposes of our analysis, without the definition being
         ;; local to the compilation unit.
         (let ((macros (compute-macros defs))
               (issued-unbound-warnings (make-hash-table)))
           (for-each
            (match-lambda
             (#(mod name use-depth def-at-use use-loc)
              (cond
               ((and (hash-ref macros (cons mod name))
                     macro-use-before-definition-enabled)
                ;; Something bound to this name is a macro, probably
                ;; later in the compilation unit.  Probably the author
                ;; made a mistake somewhere!
                (warning 'macro-use-before-definition use-loc name))
               (else
                (let ((def-at-end (resolve mod name defs)))
                  (match (cons def-at-use def-at-end)
                    (('import . 'import) #t)
                    (('import . #(is-macro? def-depth def-loc))
                     ;; At use, the binding was an import, but later
                     ;; had a local definition.  Warn as this could
                     ;; pose a hazard when reloading the module, as the
                     ;; initial binding wouldn't come from the import.
                     ;; If depth nonzero though, use might happen later
                     ;; as it might be in a lambda, so no warning in
                     ;; that case.
                     (when (and non-idempotent-definition-enabled
                                (zero? use-depth) (zero? def-depth))
                       (warning 'non-idempotent-definition use-loc name)))
                    (('unbound . 'unbound)
                     ;; No binding at all; probably an error at
                     ;; run-time, but we just warn at compile-time.
                     (when unbound-variable-enabled
                       (unless (hash-ref issued-unbound-warnings
                                         (cons mod name))
                         (hash-set! issued-unbound-warnings (cons mod name) #t)
                         (warning 'unbound-variable use-loc name))))
                    (('unbound . _)
                     ;; If the depth at the use is 0, then the use
                     ;; definitely occurs before the definition.
                     (when (and use-before-definition-enabled
                                (zero? use-depth))
                       (warning 'use-before-definition use-loc name)))
                    (('unknown-module . _)
                     ;; Could issue a warning here that for whatever
                     ;; reason, we weren't able to reason about what
                     ;; module was current!
                     #t)
                    (('unknown-declarative . 'unknown-declarative)
                     ;; FIXME: Probably we should emit a warning as in
                     ;; a declarative module perhaps this should not
                     ;; happen.
                     #t)
                    (('unknown-declarative . _)
                     ;; Def later in compilation unit than use; no
                     ;; problem.  Can occur when reloading declarative
                     ;; modules.
                     #t)
                    (('unknown-imperative . _)
                     ;; Def present and although not visible at the
                     ;; use, don't warn as use module is
                     ;; non-declarative.
                     #t)
                    (((? vector) . (? vector?))
                     ;; Def locally bound at use; no problem.
                     #t)))))))
            (reverse uses))))))

    (make-use-before-def-info 0 '() vlist-null))))