From 6a01a1a856f859e1cdb593e2cc0833b844b077be Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 26 Nov 2023 12:25:30 +0000 Subject: [PATCH] .elc format: Record lambdas' doc strings lazily, not inline Also refactor the pertinent part of bytecomp.el. * lisp/emacs-lisp/bytecomp.el (byte-compile-output-file-form): Use byte-compile-output-docform for all forms, not just those with doc strings. (byte-compile--output-docform-recurse): New function extracted from byte-compile-output-docform. This function recurses on functions contained in the constants vector. (byte-compile-output-docform): Extract parameter DOCINDEX from the INFO list. Add parameter CVECINDEX, the index of the constants vector in FORM. (byte-compile-file-form-defmumble): Several detailed refactorings. Call byte-compile-output-docform with the new interface. (byte-compile-output-as-comment): On exit, leave point after the inserted text. No longer assume that the output is being inserted at the end of the buffer. --- lisp/emacs-lisp/bytecomp.el | 270 +++++++++++++++++++++--------------- 1 file changed, 160 insertions(+), 110 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index cc68db73c9f..64fd4f6b3f3 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2477,10 +2477,9 @@ Call from the source buffer." (print-quoted t) (print-gensym t) (print-circle t)) ; Handle circular data structures. - (if (and (memq (car-safe form) '(defvar defvaralias defconst - autoload custom-declare-variable)) - (stringp (nth 3 form))) - (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil + (if (memq (car-safe form) '(defvar defvaralias defconst + autoload custom-declare-variable)) + (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 nil (memq (car form) '(defvaralias autoload custom-declare-variable))) @@ -2490,10 +2489,105 @@ Call from the source buffer." (defvar byte-compile--for-effect) -(defun byte-compile-output-docform (preface name info form specindex quoted) - "Print a form with a doc string. INFO is (prefix doc-index postfix). -If PREFACE and NAME are non-nil, print them too, -before INFO and the FORM but after the doc string itself. +(defun byte-compile--output-docform-recurse + (info position form cvecindex docindex specindex 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. +If SPECINDEX is non-nil, it is the index in FORM +of the function bytecode string. In that case, +we output that argument and the following argument +\(the constants vector) together, for lazy loading. +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 ((and (numberp specindex) (= index specindex) + ;; Don't handle the definition dynamically + ;; if it refers (or might refer) + ;; to objects already output + ;; (for instance, gensyms in the arg list). + (let (non-nil) + (when (hash-table-p print-number-table) + (maphash (lambda (_k v) (if v (setq non-nil t))) + print-number-table)) + (not non-nil))) + ;; Output the byte code and constants specially + ;; for lazy dynamic loading. + (goto-char position) + (let ((lazy-position (byte-compile-output-as-comment + (cons (car form) (nth 1 form)) + t))) + (setq position (point)) + (goto-char (point-max)) + (princ (format "(#$ . %d) nil" lazy-position) + byte-compile--outbuffer) + (setq form (cdr form)) + (setq index (1+ index)))) + ((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 specindex 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 + specindex 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. If SPECINDEX is non-nil, it is the index in FORM of the function bytecode string. In that case, we output that argument and the following argument @@ -2503,73 +2597,30 @@ 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)) + (let ((byte-compile-dynamic-docstrings byte-compile-dynamic-docstrings)) (with-current-buffer byte-compile--outbuffer - (let (position) - ;; Insert the doc string, and make it a comment with #@LENGTH. - (when (and (>= (nth 1 info) 0) dynamic-docstrings) - (setq position (byte-compile-output-as-comment - (nth (nth 1 info) form) nil))) - - (let ((print-continuous-numbering t) - print-number-table - (index 0) - ;; 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. - (if preface - (progn - ;; 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))) - (insert (car info)) - (prin1 (car form) byte-compile--outbuffer) - (while (setq form (cdr form)) - (setq index (1+ index)) - (insert " ") - (cond ((and (numberp specindex) (= index specindex) - ;; Don't handle the definition dynamically - ;; if it refers (or might refer) - ;; to objects already output - ;; (for instance, gensyms in the arg list). - (let (non-nil) - (when (hash-table-p print-number-table) - (maphash (lambda (_k v) (if v (setq non-nil t))) - print-number-table)) - (not non-nil))) - ;; Output the byte code and constants specially - ;; for lazy dynamic loading. - (let ((position - (byte-compile-output-as-comment - (cons (car form) (nth 1 form)) - t))) - (princ (format "(#$ . %d) nil" position) - byte-compile--outbuffer) - (setq form (cdr form)) - (setq index (1+ index)))) - ((= index (nth 1 info)) - (if position - (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") - position) - byte-compile--outbuffer) - (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))))) - (insert (nth 2 info))))) - nil) + (let ((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 specindex quoted) + (when tailpiece + (insert tailpiece)))))) (defun byte-compile-keep-pending (form &optional handler) (if (memq byte-optimize '(t source)) @@ -2897,60 +2948,58 @@ not to take responsibility for the actual compilation of the code." ;; Otherwise, we have a bona-fide defun/defmacro definition, and use ;; special code to allow dynamic docstrings and byte-code. (byte-compile-flush-pending) - (let ((index - ;; If there's no doc string, provide -1 as the "doc string - ;; index" so that no element will be treated as a doc string. - (if (not (stringp (documentation code t))) -1 4))) - (when byte-native-compiling - ;; Spill output for the native compiler here. - (push - (if macro - (make-byte-to-native-top-level - :form `(defalias ',name '(macro . ,code) nil) - :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 . #[" ,index "])") `(" #[" ,index "]")) - (append code nil) ; Turn byte-code-function-p into list. - (and (atom code) byte-compile-dynamic - 1) - nil)) - (princ ")" byte-compile--outbuffer) + (when byte-native-compiling + ;; Spill output for the native compiler here. + (push + (if macro + (make-byte-to-native-top-level + :form `(defalias ',name '(macro . ,code) nil) + :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 + (and (atom code) byte-compile-dynamic 1) + nil) t))))) (defun byte-compile-output-as-comment (exp quoted) - "Print Lisp object EXP in the output file, inside a comment. -Return the file (byte) position it will have. -If QUOTED is non-nil, print with quoting; otherwise, print without quoting." + "Print Lisp object EXP in the output file at point, inside a comment. +Return the file (byte) position it will have. Leave point after +the inserted text. If QUOTED is non-nil, print with quoting; +otherwise, print without quoting." (with-current-buffer byte-compile--outbuffer - (let ((position (point))) - + (let ((position (point)) end) ;; Insert EXP, and make it a comment with #@LENGTH. (insert " ") (if quoted (prin1 exp byte-compile--outbuffer) (princ exp byte-compile--outbuffer)) + (setq end (point-marker)) + (set-marker-insertion-type end t) + (goto-char position) ;; Quote certain special characters as needed. ;; get_doc_string in doc.c does the unquoting. - (while (search-forward "\^A" nil t) + (while (search-forward "\^A" end t) (replace-match "\^A\^A" t t)) (goto-char position) - (while (search-forward "\000" nil t) + (while (search-forward "\000" end t) (replace-match "\^A0" t t)) (goto-char position) - (while (search-forward "\037" nil t) + (while (search-forward "\037" end t) (replace-match "\^A_" t t)) - (goto-char (point-max)) + (goto-char end) (insert "\037") (goto-char position) - (insert "#@" (format "%d" (- (position-bytes (point-max)) + (insert "#@" (format "%d" (- (position-bytes end) (position-bytes position)))) ;; Save the file position of the object. @@ -2959,7 +3008,8 @@ If QUOTED is non-nil, print with quoting; otherwise, print without quoting." ;; position to a file position. (prog1 (- (position-bytes (point)) (point-min) -1) - (goto-char (point-max)))))) + (goto-char end) + (set-marker end nil))))) (defun byte-compile--reify-function (fun) "Return an expression which will evaluate to a function value FUN. -- 2.39.5