bytecomp.el: Rewrite the way we print dynamic docstrings

We used to print dynamic docstrings "manually" for two reasons:

- References should look like `(#$ . POS)` but `prin1` was unable
  to print just `#$` for an sexp.
- `make-docfile` needed to find those docstrings and the object
  to which they belonged.

The second point is moot now that we don't use `make-docfile` on
`.elc` files.  So this patch lifts the first restriction,
using `print-number-table`.

The rest of the patch then simplifies and regularises the
bytecompiler's generation of dynamic docstrings, which can
now also easily be done for "inner" defvars and other places.

* src/print.c (print_preprocess, print_object): Handle strings in
`print-number-table`.
(Vprint_number_table): Improve docstring.

* lisp/emacs-lisp/bytecomp.el:
(byte-compile--list-with-n): New function.
(byte-compile--docstring-style-warn): Rename from
`byte-compile-docstring-style-warn` and change calling convention.
(byte-compile--\#$, byte-compile--docstrings): New vars.
(byte-compile-close-variables): Bind them.
(byte-compile--docstring): New function.
(byte-compile-from-buffer): Set `byte-compile--\#$`.
(byte-compile-output-file-form): Use `byte-compile--\#$` instead
of special casing specific forms.
(byte-compile--output-docform-recurse, byte-compile-output-docform):
Delete functions.
(byte-compile-file-form-autoload, byte-compile-file-form-defalias)
(byte-compile-file-form-defvar-function, byte-compile-lambda):
Use `byte-compile--docstring` and `byte-compile--list-with-n`.
(byte-compile--declare-var): Add optional `not-toplevel` arg.
(byte-compile-defvar): Add `toplevel` arg.  Use `byte-compile--docstring`.
(byte-compile-file-form-defvar): Delegate to `byte-compile-defvar`.
(byte-compile--custom-declare-face): New function.  Use it for
`custom-declare-face`.
(byte-compile-file-form-defmumble): Use `byte-compile-output-file-form`

* src/doc.c (Fdocumentation_stringp): New function.
(syms_of_doc): Defsubr it.
(store_function_docstring): Remove left-over code from when we
used DOC for the docstring of some Lisp files.

* lisp/cus-face.el (custom-declare-face): Accept dynamic docstrings.
* lisp/faces.el (face-documentation): Handle dynamic docstrings.
* lisp/help-fns.el (describe-face): Simplify accordingly.

6 files changed, 218 insertions, 336 deletions

diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 0c8b6b0b97c..47afa841f5e 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -32,7 +32,7 @@
 (defun custom-declare-face (face spec doc &rest args)
   "Like `defface', but with FACE evaluated as a normal argument."
   (when (and doc
-             (not (stringp doc)))
+             (not (documentation-stringp doc)))
     (error "Invalid (or missing) doc string %S" doc))
   (unless (get face 'face-defface-spec)
     (face-spec-set face (purecopy spec) 'face-defface-spec)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index becc77f504a..6e66771658e 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -345,7 +345,7 @@ A value of `all' really means all."
   '(docstrings-non-ascii-quotes)
   "List of warning types that are only enabled during Emacs builds.
 This is typically either warning types that are being phased in
-(but shouldn't be enabled for packages yet), or that are only relevant
+\(but shouldn't be enabled for packages yet), or that are only relevant
 for the Emacs build itself.")
 
 (defvar byte-compile--suppressed-warnings nil
@@ -1740,68 +1740,82 @@ Also ignore URLs."
 The byte-compiler will emit a warning for documentation strings
 containing lines wider than this.  If `fill-column' has a larger
 value, it will override this variable."
-  :group 'bytecomp
   :type 'natnum
   :safe #'natnump
   :version "28.1")
 
-(define-obsolete-function-alias 'byte-compile-docstring-length-warn
-  'byte-compile-docstring-style-warn "29.1")
-
-(defun byte-compile-docstring-style-warn (form)
-  "Warn if there are stylistic problems with the docstring in FORM.
-Warn if documentation string of FORM is too wide.
+(defun byte-compile--list-with-n (list n elem)
+  "Return LIST with its Nth element replaced by ELEM."
+  (if (eq elem (nth n list))
+      list
+    (nconc (take n list)
+           (list elem)
+           (nthcdr (1+ n) list))))
+
+(defun byte-compile--docstring-style-warn (docs kind name)
+  "Warn if there are stylistic problems in the docstring DOCS.
+Warn if documentation string is too wide.
 It is too wide if it has any lines longer than the largest of
 `fill-column' and `byte-compile-docstring-max-column'."
   (when (byte-compile-warning-enabled-p 'docstrings)
-    (let* ((kind nil) (name nil) (docs nil)
+    (let* ((name (if (eq (car-safe name) 'quote) (cadr name) name))
            (prefix (lambda ()
                      (format "%s%s"
                              kind
-                             (if name (format-message " `%s' " name) "")))))
-      (pcase (car form)
-        ((or 'autoload 'custom-declare-variable 'defalias
-             'defconst 'define-abbrev-table
-             'defvar 'defvaralias
-             'custom-declare-face)
-         (setq kind (nth 0 form))
-         (setq name (nth 1 form))
-         (when (and (consp name) (eq (car name) 'quote))
-           (setq name (cadr name)))
-         (setq docs (nth 3 form)))
-        ('lambda
-          (setq kind "")          ; can't be "function", unfortunately
-          (setq docs (nth 2 form))))
-      (when (and kind docs (stringp docs))
-        (let ((col (max byte-compile-docstring-max-column fill-column)))
-          (when (and (byte-compile-warning-enabled-p 'docstrings-wide)
-                     (byte-compile--wide-docstring-p docs col))
-            (byte-compile-warn-x
-             name
-             "%sdocstring wider than %s characters" (funcall prefix) col)))
-        ;; There's a "naked" ' character before a symbol/list, so it
-        ;; should probably be quoted with \=.
-        (when (string-match-p (rx (| (in " \t") bol)
-                                  (? (in "\"#"))
-                                  "'"
-                                  (in "A-Za-z" "("))
+                             (if name (format-message " `%S' " name) "")))))
+      (let ((col (max byte-compile-docstring-max-column fill-column)))
+        (when (and (byte-compile-warning-enabled-p 'docstrings-wide)
+                   (byte-compile--wide-docstring-p docs col))
+          (byte-compile-warn-x
+           name
+           "%sdocstring wider than %s characters" (funcall prefix) col)))
+      ;; There's a "naked" ' character before a symbol/list, so it
+      ;; should probably be quoted with \=.
+      (when (string-match-p (rx (| (in " \t") bol)
+                                (? (in "\"#"))
+                                "'"
+                                (in "A-Za-z" "("))
+                            docs)
+        (byte-compile-warn-x
+         name
+         (concat "%sdocstring has wrong usage of unescaped single quotes"
+                 " (use \\=%c or different quoting such as %c...%c)")
+         (funcall prefix) ?' ?` ?'))
+      ;; There's a "Unicode quote" in the string -- it should probably
+      ;; be an ASCII one instead.
+      (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes)
+        (when (string-match-p (rx (| " \"" (in " \t") bol)
+                                  (in "‘’"))
                               docs)
           (byte-compile-warn-x
            name
-           (concat "%sdocstring has wrong usage of unescaped single quotes"
-                   " (use \\=%c or different quoting such as %c...%c)")
-           (funcall prefix) ?' ?` ?'))
-        ;; There's a "Unicode quote" in the string -- it should probably
-        ;; be an ASCII one instead.
-        (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes)
-          (when (string-match-p (rx (| " \"" (in " \t") bol)
-                                    (in "‘’"))
-                                docs)
-            (byte-compile-warn-x
-             name
-             "%sdocstring uses curved single quotes; use %s instead of ‘...’"
-             (funcall prefix) "`...'"))))))
-  form)
+           "%sdocstring uses curved single quotes; use %s instead of ‘...’"
+           (funcall prefix) "`...'"))))))
+
+(defvar byte-compile--\#$) ; Special value that will print as `#$'.
+(defvar byte-compile--docstrings nil "Table of already compiled docstrings.")
+
+(defun byte-compile--docstring (doc kind name &optional is-a-value)
+  (byte-compile--docstring-style-warn doc kind name)
+  ;; Make docstrings dynamic, when applicable.
+  (cond
+   ((and byte-compile-dynamic-docstrings
+         ;; The native compiler doesn't use those dynamic docstrings.
+         (not byte-native-compiling)
+         ;; Docstrings can only be dynamic when compiling a file.
+         byte-compile--\#$)
+    (let* ((byte-pos (with-memoization
+                         ;; Reuse a previously written identical docstring.
+                         ;; This is not done out of thriftiness but to try and
+                         ;; make sure that "equal" functions remain `equal'.
+                         ;; (Often those identical docstrings come from
+                         ;; `help-add-fundoc-usage').
+                         ;; Needed e.g. for `advice-tests-nadvice'.
+                         (gethash doc byte-compile--docstrings)
+                       (byte-compile-output-as-comment doc nil)))
+           (newdoc (cons byte-compile--\#$ byte-pos)))
+      (if is-a-value newdoc (macroexp-quote newdoc))))
+   (t doc)))
 
 ;; If we have compiled any calls to functions which are not known to be
 ;; defined, issue a warning enumerating them.
@@ -1836,6 +1850,8 @@ It is too wide if it has any lines longer than the largest of
           ;; macroenvironment.
           (copy-alist byte-compile-initial-macro-environment))
          (byte-compile--outbuffer nil)
+         (byte-compile--\#$ nil)
+         (byte-compile--docstrings (make-hash-table :test 'equal))
          (overriding-plist-environment nil)
          (byte-compile-function-environment nil)
          (byte-compile-bound-variables nil)
@@ -2363,7 +2379,12 @@ With argument ARG, insert value in current buffer after the form."
        (setq case-fold-search nil))
      (displaying-byte-compile-warnings
       (with-current-buffer inbuffer
-        (when byte-compile-current-file
+        (when byte-compile-dest-file
+          (setq byte-compile--\#$
+                (copy-sequence ;It needs to be a fresh new object.
+                 ;; Also it stands for the `load-file-name' when the `.elc' will
+                 ;; be loaded, so make it look like it.
+                 byte-compile-dest-file))
           (byte-compile-insert-header byte-compile-current-file
                                       byte-compile--outbuffer)
           ;; Instruct native-comp to ignore this file.
@@ -2456,11 +2477,7 @@ Call from the source buffer."
 
 (defun byte-compile-output-file-form (form)
   ;; Write the given form to the output buffer, being careful of docstrings
-  ;; (for `byte-compile-dynamic-docstrings') in defvar, defvaralias,
-  ;; defconst, autoload, and custom-declare-variable.
-  ;; defalias calls are output directly by byte-compile-file-form-defmumble;
-  ;; it does not pay to first build the defalias in defmumble and then parse
-  ;; it here.
+  ;; (for `byte-compile-dynamic-docstrings').
   (when byte-native-compiling
     ;; Spill output for the native compiler here
     (push (make-byte-to-native-top-level :form form :lexical lexical-binding)
@@ -2470,123 +2487,17 @@ Call from the source buffer."
         (print-level nil)
         (print-quoted t)
         (print-gensym t)
-        (print-circle t))               ; Handle circular data structures.
-    (if (memq (car-safe form) '(defvar defvaralias defconst
-                                 autoload custom-declare-variable))
-        (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3
-                                     (memq (car form)
-                                           '(defvaralias autoload
-                                              custom-declare-variable)))
-      (princ "\n" byte-compile--outbuffer)
-      (prin1 form byte-compile--outbuffer)
-      nil)))
+        (print-circle t)
+        (print-continuous-numbering t)
+        (print-number-table (make-hash-table :test #'eq)))
+    (when byte-compile--\#$
+      (puthash byte-compile--\#$ "#$" print-number-table))
+    (princ "\n" byte-compile--outbuffer)
+    (prin1 form byte-compile--outbuffer)
+    nil))
 
 (defvar byte-compile--for-effect)
 
-(defun byte-compile--output-docform-recurse
-    (info position form cvecindex docindex quoted)
-  "Print a form with a doc string.  INFO is (prefix postfix).
-POSITION is where the next doc string is to be inserted.
-CVECINDEX is the index in the FORM of the constant vector, or nil.
-DOCINDEX is the index of the doc string (or nil) in the FORM.
-QUOTED says that we have to put a quote before the
-list that represents a doc string reference.
-`defvaralias', `autoload' and `custom-declare-variable' need that.
-
-Return the position after any inserted docstrings as comments."
-  (let ((index 0)
-        doc-string-position)
-    ;; Insert the doc string, and make it a comment with #@LENGTH.
-    (when (and byte-compile-dynamic-docstrings
-               (stringp (nth docindex form)))
-      (goto-char position)
-      (setq doc-string-position
-            (byte-compile-output-as-comment
-             (nth docindex form) nil)
-            position (point))
-      (goto-char (point-max)))
-
-    (insert (car info))
-    (prin1 (car form) byte-compile--outbuffer)
-    (while (setq form (cdr form))
-      (setq index (1+ index))
-      (insert " ")
-      (cond ((eq index cvecindex)
-             (let* ((cvec (car form))
-                    (len (length cvec))
-                    (index2 0)
-                    elt)
-               (insert "[")
-               (while (< index2 len)
-                 (setq elt (aref cvec index2))
-                 (if (byte-code-function-p elt)
-                     (setq position
-                           (byte-compile--output-docform-recurse
-                            '("#[" "]") position
-                            (append elt nil) ; Convert the vector to a list.
-                            2 4 nil))
-                   (prin1 elt byte-compile--outbuffer))
-                 (setq index2 (1+ index2))
-                 (unless (eq index2 len)
-                   (insert " ")))
-               (insert "]")))
-            ((= index docindex)
-             (cond
-              (doc-string-position
-               (princ (format (if quoted "'(#$ . %d)"  "(#$ . %d)")
-                              doc-string-position)
-                      byte-compile--outbuffer))
-              ((stringp (car form))
-               (let ((print-escape-newlines nil))
-                 (goto-char (prog1 (1+ (point))
-                              (prin1 (car form)
-                                     byte-compile--outbuffer)))
-                 (insert "\\\n")
-                 (goto-char (point-max))))
-              (t (prin1 (car form) byte-compile--outbuffer))))
-            (t (prin1 (car form) byte-compile--outbuffer))))
-    (insert (cadr info))
-    position))
-
-(defun byte-compile-output-docform (preface tailpiece name info form
-                                            cvecindex docindex
-                                            quoted)
-  "Print a form with a doc string.  INFO is (prefix postfix).
-If PREFACE, NAME, and TAILPIECE are non-nil, print them too,
-before/after INFO and the FORM but after the doc string itself.
-CVECINDEX is the index in the FORM of the constant vector, or nil.
-DOCINDEX is the index of the doc string (or nil) in the FORM.
-QUOTED says that we have to put a quote before the
-list that represents a doc string reference.
-`defvaralias', `autoload' and `custom-declare-variable' need that."
-  ;; We need to examine byte-compile-dynamic-docstrings
-  ;; in the input buffer (now current), not in the output buffer.
-  (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
-    (with-current-buffer byte-compile--outbuffer
-      (let ((byte-compile-dynamic-docstrings dynamic-docstrings)
-            (position (point))
-            (print-continuous-numbering t)
-            print-number-table
-            ;; FIXME: The bindings below are only needed for when we're
-            ;; called from ...-defmumble.
-            (print-escape-newlines t)
-            (print-length nil)
-            (print-level nil)
-            (print-quoted t)
-            (print-gensym t)
-            (print-circle t))       ; Handle circular data structures.
-        (when preface
-          ;; FIXME: We don't handle uninterned names correctly.
-          ;; E.g. if cl-define-compiler-macro uses uninterned name we get:
-          ;;    (defalias '#1=#:foo--cmacro #[514 ...])
-          ;;    (put 'foo 'compiler-macro '#:foo--cmacro)
-          (insert preface)
-          (prin1 name byte-compile--outbuffer))
-        (byte-compile--output-docform-recurse
-         info position form cvecindex docindex quoted)
-        (when tailpiece
-          (insert tailpiece))))))
-
 (defun byte-compile-keep-pending (form &optional handler)
   (if (memq byte-optimize '(t source))
       (setq form (byte-optimize-one-form form t)))
@@ -2606,7 +2517,7 @@ list that represents a doc string reference.
   (if byte-compile-output
       (let ((form (byte-compile-out-toplevel t 'file)))
         (cond ((eq (car-safe form) 'progn)
-               (mapc 'byte-compile-output-file-form (cdr form)))
+               (mapc #'byte-compile-output-file-form (cdr form)))
               (form
                (byte-compile-output-file-form form)))
         (setq byte-compile-constants nil
@@ -2681,12 +2592,12 @@ list that represents a doc string reference.
        (setq byte-compile-unresolved-functions
              (delq (assq funsym byte-compile-unresolved-functions)
                    byte-compile-unresolved-functions)))))
-  (if (stringp (nth 3 form))
-      (prog1
-          form
-        (byte-compile-docstring-style-warn form))
-    ;; No doc string, so we can compile this as a normal form.
-    (byte-compile-keep-pending form 'byte-compile-normal-call)))
+  (let* ((doc (nth 3 form))
+         (newdoc (if (not (stringp doc)) doc
+                   (byte-compile--docstring
+                    doc 'autoload (nth 1 form)))))
+    (byte-compile-keep-pending (byte-compile--list-with-n form 3 newdoc)
+                               #'byte-compile-normal-call)))
 
 (put 'defvar   'byte-hunk-handler 'byte-compile-file-form-defvar)
 (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
@@ -2698,9 +2609,10 @@ list that represents a doc string reference.
     (byte-compile-warn-x
      sym "global/dynamic var `%s' lacks a prefix" sym)))
 
-(defun byte-compile--declare-var (sym)
+(defun byte-compile--declare-var (sym &optional not-toplevel)
   (byte-compile--check-prefixed-var sym)
-  (when (memq sym byte-compile-lexical-variables)
+  (when (and (not not-toplevel)
+             (memq sym byte-compile-lexical-variables))
     (setq byte-compile-lexical-variables
           (delq sym byte-compile-lexical-variables))
     (when (byte-compile-warning-enabled-p 'lexical sym)
@@ -2709,19 +2621,7 @@ list that represents a doc string reference.
   (push sym byte-compile--seen-defvars))
 
 (defun byte-compile-file-form-defvar (form)
-  (let ((sym (nth 1 form)))
-    (byte-compile--declare-var sym)
-    (if (eq (car form) 'defconst)
-        (push sym byte-compile-const-variables)))
-  (if (and (null (cddr form))           ;No `value' provided.
-           (eq (car form) 'defvar))     ;Just a declaration.
-      nil
-    (byte-compile-docstring-style-warn form)
-    (setq form (copy-sequence form))
-    (when (consp (nth 2 form))
-      (setcar (cdr (cdr form))
-              (byte-compile-top-level (nth 2 form) nil 'file)))
-    form))
+  (byte-compile-defvar form 'toplevel))
 
 (put 'define-abbrev-table 'byte-hunk-handler
      'byte-compile-file-form-defvar-function)
@@ -2729,26 +2629,37 @@ list that represents a doc string reference.
 
 (defun byte-compile-file-form-defvar-function (form)
   (pcase-let (((or `',name (let name nil)) (nth 1 form)))
-    (if name (byte-compile--declare-var name)))
-  ;; Variable aliases are better declared before the corresponding variable,
-  ;; since it makes it more likely that only one of the two vars has a value
-  ;; before the `defvaralias' gets executed, which avoids the need to
-  ;; merge values.
-  (pcase form
-    (`(defvaralias ,_ ',newname . ,_)
-     (when (memq newname byte-compile-bound-variables)
-       (if (byte-compile-warning-enabled-p 'suspicious)
-           (byte-compile-warn-x
-            newname
-            "Alias for `%S' should be declared before its referent" newname)))))
-  (byte-compile-docstring-style-warn form)
-  (byte-compile-keep-pending form))
+    (if name (byte-compile--declare-var name))
+    ;; Variable aliases are better declared before the corresponding variable,
+    ;; since it makes it more likely that only one of the two vars has a value
+    ;; before the `defvaralias' gets executed, which avoids the need to
+    ;; merge values.
+    (pcase form
+      (`(defvaralias ,_ ',newname . ,_)
+       (when (memq newname byte-compile-bound-variables)
+         (if (byte-compile-warning-enabled-p 'suspicious)
+             (byte-compile-warn-x
+              newname
+              "Alias for `%S' should be declared before its referent"
+              newname)))))
+    (let ((doc (nth 3 form)))
+      (when (stringp doc)
+        (setcar (nthcdr 3 form)
+                (byte-compile--docstring doc (nth 0 form) name))))
+    (byte-compile-keep-pending form)))
 
 (put 'custom-declare-variable 'byte-hunk-handler
      'byte-compile-file-form-defvar-function)
 
 (put 'custom-declare-face 'byte-hunk-handler
-     'byte-compile-docstring-style-warn)
+     #'byte-compile--custom-declare-face)
+(defun byte-compile--custom-declare-face (form)
+  (let ((kind (nth 0 form)) (name (nth 1 form)) (docs (nth 3 form)))
+    (when (stringp docs)
+      (let ((newdocs (byte-compile--docstring docs kind name)))
+        (unless (eq docs newdocs)
+          (setq form (byte-compile--list-with-n form 3 newdocs)))))
+    form))
 
 (put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
 (defun byte-compile-file-form-require (form)
@@ -2902,33 +2813,24 @@ not to take responsibility for the actual compilation of the code."
                (cons (cons bare-name code)
                      (symbol-value this-kind))))
 
-        (if rest
-            ;; There are additional args to `defalias' (like maybe a docstring)
-            ;; that the code below can't handle: punt!
-            nil
-          ;; Otherwise, we have a bona-fide defun/defmacro definition, and use
-          ;; special code to allow dynamic docstrings and byte-code.
-          (byte-compile-flush-pending)
+        (byte-compile-flush-pending)
+        (let ((newform `(defalias ',bare-name
+                         ,(if macro `'(macro . ,code) code) ,@rest)))
           (when byte-native-compiling
-            ;; Spill output for the native compiler here.
+            ;; Don't let `byte-compile-output-file-form' push the form to
+            ;; `byte-to-native-top-level-forms' because we want to use
+            ;; `make-byte-to-native-func-def' when possible.
             (push
-             (if macro
+             (if (or macro rest)
                  (make-byte-to-native-top-level
-                  :form `(defalias ',name '(macro . ,code) nil)
+                  :form newform
                   :lexical lexical-binding)
                (make-byte-to-native-func-def :name name
                                              :byte-func code))
              byte-to-native-top-level-forms))
-          ;; Output the form by hand, that's much simpler than having
-          ;; b-c-output-file-form analyze the defalias.
-          (byte-compile-output-docform
-           "\n(defalias '" ")"
-           bare-name
-           (if macro '(" '(macro . #[" "])") '(" #[" "]"))
-           (append code nil)          ; Turn byte-code-function-p into list.
-           2 4
-           nil)
-          t)))))
+          (let ((byte-native-compiling nil))
+           (byte-compile-output-file-form newform)))
+        t))))
 
 (defun byte-compile-output-as-comment (exp quoted)
   "Print Lisp object EXP in the output file at point, inside a comment.
@@ -3129,9 +3031,9 @@ lambda-expression."
       (setq fun (cons 'lambda fun))
     (unless (eq 'lambda (car-safe fun))
       (error "Not a lambda list: %S" fun)))
-  (byte-compile-docstring-style-warn fun)
   (byte-compile-check-lambda-list (nth 1 fun))
   (let* ((arglist (nth 1 fun))
+         (bare-arglist (byte-run-strip-symbol-positions arglist)) ; for compile-defun.
          (arglistvars (byte-run-strip-symbol-positions
                        (byte-compile-arglist-vars arglist)))
          (byte-compile-bound-variables
@@ -3140,16 +3042,22 @@ lambda-expression."
          (body (cdr (cdr fun)))
          (doc (if (stringp (car body))
                   (prog1 (car body)
-                    ;; Discard the doc string
+                    ;; Discard the doc string from the body
                     ;; unless it is the last element of the body.
                     (if (cdr body)
                         (setq body (cdr body))))))
          (int (assq 'interactive body))
          command-modes)
     (when lexical-binding
+      (when arglist
+        ;; byte-compile-make-args-desc lost the args's names,
+        ;; so preserve them in the docstring.
+        (setq doc (help-add-fundoc-usage doc bare-arglist)))
       (dolist (var arglistvars)
         (when (assq var byte-compile--known-dynamic-vars)
           (byte-compile--warn-lexical-dynamic var 'lambda))))
+    (when (stringp doc)
+      (setq doc (byte-compile--docstring doc "" nil 'is-a-value)))
     ;; Process the interactive spec.
     (when int
       ;; Skip (interactive) if it is in front (the most usual location).
@@ -3193,8 +3101,7 @@ lambda-expression."
                                    (and lexical-binding
                                         (byte-compile-make-lambda-lexenv
                                          arglistvars))
-                                   reserved-csts))
-          (bare-arglist (byte-run-strip-symbol-positions arglist))) ; for compile-defun.
+                                   reserved-csts)))
       ;; Build the actual byte-coded function.
       (cl-assert (eq 'byte-code (car-safe compiled)))
       (let ((out
@@ -3206,12 +3113,7 @@ lambda-expression."
                      ;; byte-string, constants-vector, stack depth
                      (cdr compiled)
                      ;; optionally, the doc string.
-                     (cond ((and lexical-binding arglist)
-                            ;; byte-compile-make-args-desc lost the args's names,
-                            ;; so preserve them in the docstring.
-                            (list (help-add-fundoc-usage doc bare-arglist)))
-                           ((or doc int)
-                            (list doc)))
+                     (when (or doc int) (list doc))
                      ;; optionally, the interactive spec (and the modes the
                      ;; command applies to).
                      (cond
@@ -5091,49 +4993,49 @@ binding slots have been popped."
     (push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars))
   (byte-compile-normal-call form))
 
-(defun byte-compile-defvar (form)
-  ;; This is not used for file-level defvar/consts.
-  (when (and (symbolp (nth 1 form))
-             (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
-             (byte-compile-warning-enabled-p 'lexical (nth 1 form)))
-    (byte-compile-warn-x
-     (nth 1 form)
-     "global/dynamic var `%s' lacks a prefix"
-     (nth 1 form)))
-  (byte-compile-docstring-style-warn form)
-  (let ((fun (nth 0 form))
-        (var (nth 1 form))
-        (value (nth 2 form))
-        (string (nth 3 form)))
-    (when (or (> (length form) 4)
-              (and (eq fun 'defconst) (null (cddr form))))
-      (let ((ncall (length (cdr form))))
-        (byte-compile-warn-x
-         fun
-         "`%s' called with %d argument%s, but %s %s"
-         fun ncall
-         (if (= 1 ncall) "" "s")
-         (if (< ncall 2) "requires" "accepts only")
-         "2-3")))
-    (push var byte-compile-bound-variables)
+(defun byte-compile-defvar (form &optional toplevel)
+  (let* ((fun (nth 0 form))
+         (var (nth 1 form))
+         (value (nth 2 form))
+         (string (nth 3 form)))
+    (byte-compile--declare-var var (not toplevel))
     (if (eq fun 'defconst)
         (push var byte-compile-const-variables))
-    (when (and string (not (stringp string)))
+    (cond
+     ((stringp string)
+      (setq string (byte-compile--docstring string fun var 'is-a-value)))
+     (string
       (byte-compile-warn-x
        string
        "third arg to `%s %s' is not a string: %s"
-       fun var string))
-    ;; Delegate the actual work to the function version of the
-    ;; special form, named with a "-1" suffix.
-    (byte-compile-form-do-effect
-     (cond
-      ((eq fun 'defconst) `(defconst-1 ',var ,@(nthcdr 2 form)))
-      ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo.
-      (t `(defvar-1 ',var
-                    ;; Don't eval `value' if `defvar' wouldn't eval it either.
-                    ,(if (macroexp-const-p value) value
-                       `(if (boundp ',var) nil ,value))
-                    ,@(nthcdr 3 form)))))))
+       fun var string)))
+    (if toplevel
+        ;; At top-level we emit calls to defvar/defconst.
+        (if (and (null (cddr form))       ;No `value' provided.
+                 (eq (car form) 'defvar)) ;Just a declaration.
+            nil
+          (let ((tail (nthcdr 4 form)))
+            (when (or tail string) (push string tail))
+            (when (cddr form)
+              (push (if (not (consp value)) value
+                        (byte-compile-top-level value nil 'file))
+                    tail))
+            `(,fun ,var ,@tail)))
+      ;; At non-top-level, since there is no byte code for
+      ;; defvar/defconst, we delegate the actual work to the function
+      ;; version of the special form, named with a "-1" suffix.
+      (byte-compile-form-do-effect
+       (cond
+        ((eq fun 'defconst)
+         `(defconst-1 ',var ,@(byte-compile--list-with-n
+                               (nthcdr 2 form) 1 (macroexp-quote string))))
+        ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo.
+        (t `(defvar-1 ',var
+                      ;; Don't eval `value' if `defvar' wouldn't eval it either.
+                      ,(if (macroexp-const-p value) value
+                         `(if (boundp ',var) nil ,value))
+                      ,@(byte-compile--list-with-n
+                         (nthcdr 3 form) 0 (macroexp-quote string)))))))))
 
 (defun byte-compile-autoload (form)
   (and (macroexp-const-p (nth 1 form))
@@ -5159,14 +5061,6 @@ binding slots have been popped."
   ;; For the compilation itself, we could largely get rid of this hunk-handler,
   ;; if it weren't for the fact that we need to figure out when a defalias
   ;; defines a macro, so as to add it to byte-compile-macro-environment.
-  ;;
-  ;; FIXME: we also use this hunk-handler to implement the function's
-  ;; dynamic docstring feature (via byte-compile-file-form-defmumble).
-  ;; We should probably actually implement it (more elegantly) in
-  ;; byte-compile-lambda so it applies to all lambdas.  We did it here
-  ;; so the resulting .elc format was recognizable by make-docfile,
-  ;; but since then we stopped using DOC for the docstrings of
-  ;; preloaded elc files so that obstacle is gone.
   (let ((byte-compile-free-references nil)
         (byte-compile-free-assignments nil))
     (pcase form
@@ -5175,7 +5069,11 @@ binding slots have been popped."
       ;; - `arg' is the expression to which it is defined.
       ;; - `rest' is the rest of the arguments.
       (`(,_ ',name ,arg . ,rest)
-       (byte-compile-docstring-style-warn form)
+       (let ((doc (car rest)))
+         (when (stringp doc)
+           (setq rest (byte-compile--list-with-n
+                       rest 0
+                       (byte-compile--docstring doc (nth 0 form) name)))))
        (pcase-let*
            ;; `macro' is non-nil if it defines a macro.
            ;; `fun' is the function part of `arg' (defaults to `arg').
diff --git a/lisp/faces.el b/lisp/faces.el
index d5120f42b92..c3a54a08a3d 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -651,11 +651,11 @@ Optional argument INHERIT is passed to `face-attribute'."
 If FACE is a face-alias, get the documentation for the target face."
   (let ((alias (get face 'face-alias)))
     (if alias
-        (let ((doc (get alias 'face-documentation)))
+        (let ((doc (documentation-property alias 'face-documentation)))
           (format "%s is an alias for the face `%s'.%s" face alias
                   (if doc (format "\n%s" doc)
                     "")))
-      (get face 'face-documentation))))
+      (documentation-property face 'face-documentation))))
 
 
 (defun set-face-documentation (face string)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 99642d08bbd..1ba848c107d 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1799,9 +1799,8 @@ If FRAME is omitted or nil, use the selected frame."
                            alias)
                         ""))))
                   (insert "\nDocumentation:\n"
-                          (substitute-command-keys
-                           (or (face-documentation face)
-                               "Not documented as a face."))
+                          (or (face-documentation face)
+                              "Not documented as a face.")
                           "\n\n"))
                 (with-current-buffer standard-output
                   (save-excursion
diff --git a/src/doc.c b/src/doc.c
index a451b468ef2..b5a9ed498af 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -357,6 +357,20 @@ reread_doc_file (Lisp_Object file)
   return 1;
 }
 
+DEFUN ("documentation-stringp", Fdocumentation_stringp, Sdocumentation_stringp,
+       1, 1, 0,
+       doc: /* Return non-nil if OBJECT is a well-formed docstring object.
+OBJECT can be either a string or a reference if it's kept externally.  */)
+  (Lisp_Object object)
+{
+  return (STRINGP (object)
+          || FIXNUMP (object)   /* Reference to DOC.  */
+          || (CONSP (object)    /* Reference to .elc.  */
+              && STRINGP (XCAR (object))
+              && FIXNUMP (XCDR (object)))
+          ? Qt : Qnil);
+}
+
 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
        doc: /* Return the documentation string of FUNCTION.
 Unless a non-nil second argument RAW is given, the
@@ -502,46 +516,13 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
   /* If it's a lisp form, stick it in the form.  */
   if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
     fun = XCDR (fun);
-  if (CONSP (fun))
-    {
-      Lisp_Object tem = XCAR (fun);
-      if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
-          || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
-        {
-          tem = Fcdr (Fcdr (fun));
-          if (CONSP (tem) && FIXNUMP (XCAR (tem)))
-            /* FIXME: This modifies typically pure hash-cons'd data, so its
-               correctness is quite delicate.  */
-            XSETCAR (tem, make_fixnum (offset));
-        }
-    }
   /* Lisp_Subrs have a slot for it.  */
-  else if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun))
-    {
-      XSUBR (fun)->doc = offset;
-    }
-
-  /* Bytecode objects sometimes have slots for it.  */
-  else if (COMPILEDP (fun))
+  if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun))
+    XSUBR (fun)->doc = offset;
+  else
     {
-      /* This bytecode object must have a slot for the
-         docstring, since we've found a docstring for it.  */
-      if (PVSIZE (fun) > COMPILED_DOC_STRING
-          /* Don't overwrite a non-docstring value placed there,
-           * such as the symbols used for Oclosures.  */
-          && VALID_DOCSTRING_P (AREF (fun, COMPILED_DOC_STRING)))
-        ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset));
-      else
-        {
-          AUTO_STRING (format,
-                       (PVSIZE (fun) > COMPILED_DOC_STRING
-                        ? "Docstring slot busy for %s"
-                        : "No docstring slot for %s"));
-          CALLN (Fmessage, format,
-                 (SYMBOLP (obj)
-                  ? SYMBOL_NAME (obj)
-                  : build_string ("<anonymous>")));
-        }
+      AUTO_STRING (format, "Ignoring DOC string on non-subr: %S");
+      CALLN (Fmessage, format, obj);
     }
 }
 
@@ -776,6 +757,7 @@ compute the correct value for the current terminal in the nil case.  */);
                doc: /* If nil, a nil `text-quoting-style' is treated as `grave'.  */);
   /* Initialized by ‘main’.  */
 
+  defsubr (&Sdocumentation_stringp);
   defsubr (&Sdocumentation);
   defsubr (&Ssubr_documentation);
   defsubr (&Sdocumentation_property);
diff --git a/src/print.c b/src/print.c
index c6a3dba3163..c2beff0ed55 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1412,7 +1412,7 @@ print_preprocess (Lisp_Object obj)
                   && SYMBOLP (obj)
                   && !SYMBOL_INTERNED_P (obj)))
             { /* OBJ appears more than once.  Let's remember that.  */
-              if (!FIXNUMP (num))
+              if (SYMBOLP (num)) /* In practice, nil or t.  */
                 {
                   print_number_index++;
                   /* Negative number indicates it hasn't been printed yet.  */
@@ -2265,6 +2265,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
               goto next_obj;
             }
         }
+      else if (STRINGP (num))
+        {
+          strout (SDATA (num), SCHARS (num), SBYTES (num), printcharfun);
+          goto next_obj;
+        }
     }
 
   print_depth++;
@@ -2554,11 +2559,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
           goto next_obj;
         case PVEC_SUB_CHAR_TABLE:
           {
-            /* Make each lowest sub_char_table start a new line.
-               Otherwise we'll make a line extremely long, which
-               results in slow redisplay.  */
-            if (XSUB_CHAR_TABLE (obj)->depth == 3)
-              printchar ('\n', printcharfun);
             print_c_string ("#^^[", printcharfun);
             int n = sprintf (buf, "%d %d",
                              XSUB_CHAR_TABLE (obj)->depth,
@@ -2664,7 +2664,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
                     /* With the print-circle feature.  */
                     Lisp_Object num = Fgethash (next, Vprint_number_table,
                                                 Qnil);
-                    if (FIXNUMP (num))
+                    if (!(NILP (num) || EQ (num, Qt)))
                       {
                         print_c_string (" . ", printcharfun);
                         obj = next;
@@ -2928,7 +2928,10 @@ This variable should not be set with `setq'; bind it with a `let' instead.  */);
   DEFVAR_LISP ("print-number-table", Vprint_number_table,
                doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
 The Lisp printer uses this vector to detect Lisp objects referenced more
-than once.
+than once.  If an entry contains a number, then the corresponding key is
+referenced more than once: a positive sign indicates that it's already been
+printed, and the absolute value indicates the number to use when printing.
+If an entry contains a string, that string is printed instead.
 
 When you bind `print-continuous-numbering' to t, you should probably
 also bind `print-number-table' to nil.  This ensures that the value of