(let* {[excluded '(; environment
                   S 1arg-lambda? argc-error
                   bcode:indexfor bcode:stack box-vars bq-bracket bq-bracket1
                   bq-process builtin->instruction capture-var!
                   compile compile-and compile-app compile-arglist compile-aset!
                   compile-begin compile-builtin-call compile-error compile-f compile-f-
                   compile-if compile-in compile-let compile-or compile-prog1
                   compile-set!  compile-short-circuit compile-sym compile-thunk
                   compile-while compile-bindings compile-bindings-
                   complex-bindings complex-bindings-
                   const-to-idx-vec emit emit-optional-arg-inits encode-byte-code
                   expand-def extend-env get-defined-vars in-env? inlineable?
                   keyword->sym keyword-arg?
                   lambda lambda-vars lambda:body lambda:vars lookup-sym lower-def
                   make-code-emitter quoted? reverse!- reverse-
                   self-evaluating? vars-to-env vinfo vinfo:heap? vinfo:index vinfo:sym
                   ; syntax
                   bcode:cenv bcode:code bcode:ctable bcode:nconst bcode:sp bcode:spmax
                   make-label mark-label)]
       [withdocs 0]
       [nodocs 0]
       [issues 0]
       [doc-group? (λ (k) (and (cons? k)
                               (eq? (car k) 'doc)
                               (eq? (cadr k) 'group)))]
       [collect-group-key (λ (k _ z) (if (doc-group? k)
                                         (cons (caddr k) z)
                                         z))]
       [all-docs (get *properties* '*doc*)]
       [all-groups (table-fold collect-group-key NIL all-docs)]
       [warn (λ (e . msg) (set! issues (1+ issues))
                          (apply princ msg)
                          (princ ": " e)
                          (newline))]
       [validate-group (λ (e extra)
         (let {[groups (map cdr (filter (λ (v) (eq? (car v) :doc-group)) extra))]}
           (unless groups
             (warn e "no group"))
           (for-each (λ (group) (unless (memq group all-groups)
                                  (warn e "group " group " undefined")))
                     groups)))]
       [validate-see (λ (e extra)
         (let {[sees (map cdr (filter (λ (v) (eq? (car v) :doc-see)) extra))]}
           (for-each (λ (see) (when (not (str? see))
                                (unless (or (get-syntax see) (bound? see))
                                  (warn e "undefined \"see\" " see))))
                     sees)))]
       [hidden? (λ (term) (let {[s (str term)]}
                            (or (eq? #\% (str-rune s 0))      ; %blah
                                (memq term excluded)
                                (and (eq? #\_ (str-rune s 0)) ; __blah
                                     (eq? #\_ (str-rune s 1))))))]
       [validate (λ (get keys)
         (for-each (λ (e)
                     (let* {[v (get e)]
                            [extra (getprop e '*doc-extra* NIL)]}
                       (unless (hidden? e)
                         (if (getprop e '*doc* NIL)
                             (begin (if extra
                                        (begin (validate-group e extra)
                                               (validate-see e extra))
                                        (warn e "no extra"))
                                    (set! withdocs (1+ withdocs)))
                             (begin (set! nodocs (1+ nodocs))
                                    (warn e "no docs"))))))
         keys))]}
  (io-buffer-mode! *io-out* :block)
  (princ "Environment:")
  (newline)
  (validate top-level-value (sort (environment) <))
  (newline)
  (princ "Syntax environment:")
  (newline)
  (validate get-syntax (sort (table-keys *syntax-environment*) <))
  (newline)
  (princ "Other issues:")
  (newline)
  (for-each (λ (e _) (unless (or (not (sym? e)) (bound? e) (get-syntax e))
                       (warn e "undefined with docs")))
            (get *properties* '*doc*))
  (newline)
  (princ "Total symbols: " (+ withdocs nodocs))
  (newline)
  (princ "Documented:    " withdocs)
  (newline)
  (princ "Undocumented:  " nodocs)
  (newline)
  (princ "Issues:        " issues)
  (newline))