)
  (define (add-binding! mod name)
    (set! bindings (acons mod name bindings)))

  (define (record-bindings! mod vars vals)
    (for-each
     (lambda (var val)
       (match val
         (($ <call> _ ($ <module-ref> _ '(guile) 'define-module* #f)
             (($ <const> _ mod) . args))
          (add-module-definition! mod args)
          (add-module-lexical! var mod))
         (($ <primcall> _ 'current-module ())
          (when mod
            (add-module-lexical! var mod)))
         (_ #f)))
     vars vals))

  ;; Thread a conservative idea of what the current module is through
  ;; the visit.  Visiting an expression returns the name of the current
  ;; module when the expression completes, or #f if unknown.  Record the
  ;; define-module* forms, if any, and note any toplevel definitions.
  (define (visit exp) (visit/mod exp #f))
  (define (visit* exps)
    (unless (null? exps)
      (visit (car exps))
      (visit* (cdr exps))))
  (define (visit+ exps mod)
    (match exps
      (() mod)
      ((exp . exps)
       (let lp ((mod' (visit/mod exp mod)) (exps exps))
         (match exps
           (() mod')
           ((exp . exps)
            (lp (and (equal? mod' (visit/mod exp mod)) mod')
                exps)))))))
  (define (visit/mod exp mod)
    (match exp
      ((or ($ <void>) ($ <const>) ($ <primitive-ref>) ($ <lexical-ref>)
           ($ <module-ref>) ($ <toplevel-ref>))
       mod)

      (($ <call> _ ($ <module-ref> _ '(guile) 'set-current-module #f)
          (($ <lexical-ref> _ _ var)))
       (assq-ref module-lexicals var))

      (($ <call> _ proc args)
       (visit proc)
       (visit* args)
       #f)

      (($ <primcall> _ _ args)
       ;; There is no primcall that sets the current module.
       (visit+ args mod))

      (($ <conditional> src test consequent alternate)
       (visit+ (list consequent alternate) (visit/mod test mod)))

      (($ <lexical-set> src name gensym exp)
       (visit/mod exp mod))

      (($ <toplevel-set> src mod name exp)
       (visit/mod exp mod))

      (($ <module-set> src mod name public? exp)
       (visit/mod exp mod))

      (($ <toplevel-define> src mod name exp)
       (add-binding! mod name)
       (visit/mod exp mod))

      (($ <lambda> src meta body)
       (when body (visit body))
       mod)

      (($ <lambda-case> src req opt rest kw inits gensyms body alternate)
       (visit* inits)
       (let* ((bodies (cons body inits))
              (bodies (if alternate (cons alternate bodies) bodies)))
         (visit+ bodies mod)))

      (($ <seq> src head tail)
       (visit/mod tail (visit/mod head mod)))

      (($ <let> src names gensyms vals body)
       (record-bindings! mod gensyms vals)
       (visit/mod body (visit+ vals mod)))

      (($ <letrec> src in-order? names gensyms vals body)
       (record-bindings! mod gensyms vals)
       (visit/mod body (visit+ vals mod)))

      (($ <fix> src names gensyms vals body)
       (record-bindings! mod gensyms vals)
       (visit/mod body (visit+ vals mod)))

      (($ <let-values> src exp body)
       (visit/mod body (visit/mod exp mod)))

      (($ <prompt> src escape-only? tag body handler)
       (visit+ (list body handler) (visit/mod tag mod)))

      (($ <abort> src tag args tail)
       (visit tag)
       (visit* args)
       (visit tail)
       #f)))

  (visit exp)

  (define (kwarg-ref args kw kt kf)
    (let lp ((args args))
      (match args
        (() (kf))
        ((($ <const> _ (? keyword? kw')) val . args)
         (if (eq? kw' kw)
             (kt val)
             (lp args)))
        ((_ _ . args)
         (lp args)))))
  (define (kwarg-ref/const args kw kt kf)
    (kwarg-ref args kw
               (lambda (exp)
                 (match exp
                   (($ <const> _ val') (kt val'))
                   (_ (kf))))
               kf))
  (define (has-constant-initarg? args kw val)
    (kwarg-ref/const args kw
                     (lambda (val')
                       (equal? val val'))
                     (lambda () #f)))

  ;; Collect declarative modules defined once in this compilation unit.
  (define declarative-modules
    (let lp ((defs module-definitions) (not-declarative '()) (declarative '()))
      (match defs
        (() declarative)
        (((mod . args) . defs)
         (cond ((member mod not-declarative)
                (lp defs not-declarative declarative))
               ((or (assoc mod defs) ;; doubly defined?
                    (not (has-constant-initarg? args #:declarative? #t)))
                (lp defs (cons mod not-declarative) declarative))
               (else
                (lp defs not-declarative (cons mod declarative))))))))

  (define resolvers
    (map (lambda (mod)
           (define resolve
             (make-resolver mod
                            (filter-map (match-lambda
                                          ((mod' . name)
                                           (and (equal? mod mod') name)))
                                        bindings)))
           (cons mod resolve))
         declarative-modules))

  (lambda (mod name)
    (cond
     ((assoc-ref resolvers mod)
      => (lambda (resolve) (resolve name)))
     (else 'unknown))))

(define (resolve-free-vars exp)
  "Traverse @var{exp}, extracting module-level definitions."
  (define resolve
    (compute-free-var-resolver exp))

  (post-order
   (lambda (exp)
     (match exp
       (($ <toplevel-ref> src mod name)
        (match (resolve mod name)
          ((or 'unknown 'duplicate 'local) exp)
          ((mod . name)
           (make-module-ref src mod name #t))))
       (($ <toplevel-set> src mod name val)
        (match (resolve mod name)
          ((or 'unknown 'duplicate 'local) exp)
          ((mod . name)
           (make-module-set src mod name #t val))))
       (exp exp)))
   exp))
