(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))