())) corresponds to
  ;;
  ;;  ,-------.
  ;;  v       |
  ;;  A ----> B
  ;;  |
  ;;  v
  ;;  C
  ;;
  ;; REACHABLE is a vhash of nodes known to be otherwise reachable.

  (let loop ((root   root)
             (path   vlist-null)
             (result reachable))
    (if (or (vhash-assq root path)
            (vhash-assq root result))
        result
        (let* ((children (or (and=> (vhash-assq root refs) cdr) '()))
               (path     (vhash-consq root #t path))
               (result   (fold (lambda (kid result)
                                 (loop kid path result))
                               result
                               children)))
          (fold (lambda (kid result)
                  (vhash-consq kid #t result))
                result
                children)))))

(define (graph-reachable-nodes* roots refs)
  ;; Return the list of nodes in REFS reachable from the nodes listed in ROOTS.
  (vlist-fold (lambda (root+true result)
                (let* ((root      (car root+true))
                       (reachable (graph-reachable-nodes root refs result)))
                  (vhash-consq root #t reachable)))
              vlist-null
              roots))

(define (partition* pred vhash)
  ;; Partition VHASH according to PRED.  Return the two resulting vhashes.
  (let ((result
         (vlist-fold (lambda (k+v result)
                       (let ((k  (car k+v))
                             (v  (cdr k+v))
                             (r1 (car result))
                             (r2 (cdr result)))
                         (if (pred k)
                             (cons (vhash-consq k v r1) r2)
                             (cons r1 (vhash-consq k v r2)))))
                     (cons vlist-null vlist-null)
                     vhash)))
    (values (car result) (cdr result))))

(define unused-toplevel-analysis
  ;; Report unused top-level definitions that are not exported.
  (let ()
    (define initial-graph
      (make-reference-graph vlist-null vlist-null #f))

    (define (add-def graph name src)
      (match graph
        (($ <reference-graph> defs refs ctx)
         (make-reference-graph (vhash-consq name src defs) refs name))))

    (define (add-ref graph pred succ)
      ;; Add a ref edge PRED -> SUCC in GRAPH.
      (match graph
        (($ <reference-graph> defs refs ctx)
         (let* ((succs (match (vhash-assq pred refs)
                         ((pred . succs) succs)
                         (#f '())))
                (refs (vhash-consq pred (cons succ succs) refs)))
           (make-reference-graph defs refs ctx)))))

    (define (add-ref-from-context graph name)
      ;; Add a ref edge from the current context to NAME in GRAPH.
      (add-ref graph (reference-graph-toplevel-context graph) name))

    (define (add-root-ref graph name)
      ;; Add a ref edge to NAME from the root, because its metadata is
      ;; marked maybe-unused.
      (add-ref graph #f name))

    (define (macro-variable? name env)
      (and (module? env)
           (let ((var (module-variable env name)))
             (and var (variable-bound? var)
                  (macro? (variable-ref var))))))

    (define (maybe-unused? metadata)
      (assq 'maybe-unused metadata))

    (make-tree-analysis
     (lambda (x graph env locs)
       ;; Going down into X.
       (match x
         (($ <toplevel-ref> src mod name)
          (add-ref-from-context graph name))
         (($ <toplevel-define> src mod name expr)
          (let ((graph (add-def graph name (or src (find pair? locs)))))
            (match expr
              (($ <lambda> src (? maybe-unused?) body)
               (add-root-ref graph name))
              (_ graph))))
         (($ <toplevel-set> src mod name expr)
          (add-ref-from-context graph name))
         (_ graph)))

     (lambda (x graph env locs)
       ;; Leaving X's scope.
       (match x
         (($ <toplevel-define>)
          (match graph
            (($ <reference-graph> defs refs ctx)
             (make-reference-graph defs refs #f))))
         (_ graph)))

     (lambda (graph env)
       ;; Process the resulting reference graph: determine all private definitions
       ;; not reachable from any public definition.  Macros
       ;; (syntax-transformers), which are globally bound, never considered
       ;; unused since we can't tell whether a macro is actually used; in
       ;; addition, macros are considered roots of the graph since they may use
       ;; private bindings.  FIXME: The `make-syntax-transformer' calls don't
       ;; contain any literal `toplevel-ref' of the global bindings they use so
       ;; this strategy fails.
       (define exports (make-hash-table))
       (when (module? env)
         (module-for-each (lambda (name var) (hashq-set! exports var name))
                          (module-public-interface env)))
       (define (exported? name)
         (if (module? env)
             (and=> (module-variable env name)
                    (lambda (var)
                      (hashq-ref exports var)))
             #t))

       (let-values (((public-defs private-defs)
                     (partition* (lambda (name)
                                   (or (exported? name)
                                       (macro-variable? name env)))
                                 (reference-graph-defs graph))))
         (let* ((roots     (vhash-consq #f #t public-defs))
                (refs      (reference-graph-refs graph))
                (reachable (graph-reachable-nodes* roots refs))
                (unused    (vlist-filter (lambda (name+src)
                                           (not (vhash-assq (car name+src)
                                                            reachable)))
                                         private-defs)))
           (vlist-for-each (lambda (name+loc)
                             (let ((name (car name+loc))
                                   (loc  (cdr name+loc)))
                               (if (not (gensym? name))
                                   (warning 'unused-toplevel loc name))))
                           unused))))

     initial-graph)))