mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
Commit fixes and enhancements to the scratch/correct-warning-pos branch
No longer strip positions from symbols before each use of a form, instead relying on the low level C routines to do the right thing. Instead strip them from miscellaneous places where this is needed. Stip them alson in `function-put'. Push forms onto byte-compile-form-stack and pop them "by hand" rather than by binding the variable at each pushing, so that it will still have its data after an error has been thrown and caught by a condition case. This gives an source position to the ensuing error message. * lisp/emacs-lisp/byte-run.el (byte-run--ssp-seen, byte-run--circular-list-p) (byte-run--strip-s-p-1, byte-run-strip-symbol-positions): New functions and variables, which together implement stripping of symbol positions. The latest (?final) version modifies the argument in place rather than making a copy. (function-put): Strip symbol positions from all of the arguments before doing the `put'. * lisp/emacs-lisp/bytecomp.el (byte-compile--form-stack): has been renamed to byte-compile-form-stack and moved to macroexp.el. (byte-compile-initial-macro-environment (eval-and-compile)): Replace macroexpand-all-toplevel with macroexpand--all-toplevel. (displaying-byte-compile-warnings): bind byte-compile-form-stack here. (byte-compile-toplevel-file-form, byte-compile-form): Push the top level form onto byte-compile-form-stack (whereas formally the variable was bound at each pushing). Manually pop this from of the variable at the end of the function. * lisp/emacs-lisp/cl-macs.el (cl-define-compiler-macro): Remove the symbol stripping. * lisp/emacs-lisp/comp.el (comp--native-compile): Set max-specpdl-size to at least 5000 (previously it was 2500). Bind print-symbols-bare to t. * lisp/emacs-lisp/macroexp.el (byte-compile-form-stack): Definition move here from bytecomp.el for easier compilation. (byte-compile-strip-symbol-positions and associated functions): Removed. (macro--expand-all): push argument FORM onto byte-compile-form-stack at the start of this function, and pop it off at the end. (internal-macroexpand-for-load): No longer strip symbol positions. Bind symbols-with-pos-enabled and print-symbols-bare to t. * lisp/help.el (help--make-usage): Strip any position from argument ARG. * src/fns.c (Fput): No longer strip symbol positions from any of the arguments.
This commit is contained in:
parent
2128cd8c08
commit
57b698f159
7 changed files with 296 additions and 295 deletions
|
|
@ -30,6 +30,83 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(defvar byte-run--ssp-seen nil
|
||||
"Which conses/vectors/records have been processed in strip-symbol-positions?
|
||||
The value is a hash table, the key being the old element and the value being
|
||||
the corresponding new element of the same type.
|
||||
|
||||
The purpose of this is to detect circular structures.")
|
||||
|
||||
(defalias 'byte-run--circular-list-p
|
||||
#'(lambda (l)
|
||||
"Return non-nil when the list L is a circular list.
|
||||
Note that this algorithm doesn't check any circularity in the
|
||||
CARs of list elements."
|
||||
(let ((hare l)
|
||||
(tortoise l))
|
||||
(condition-case err
|
||||
(progn
|
||||
(while (progn
|
||||
(setq hare (cdr (cdr hare))
|
||||
tortoise (cdr tortoise))
|
||||
(not (or (eq tortoise hare)
|
||||
(null hare)))))
|
||||
(eq tortoise hare))
|
||||
(wrong-type-argument nil)
|
||||
(error (signal (car err) (cdr err)))))))
|
||||
|
||||
(defalias 'byte-run--strip-s-p-1
|
||||
#'(lambda (arg)
|
||||
"Strip all positions from symbols in ARG, modifying ARG.
|
||||
Return the modified ARG."
|
||||
(cond
|
||||
((symbol-with-pos-p arg)
|
||||
(bare-symbol arg))
|
||||
|
||||
((consp arg)
|
||||
(let* ((round (byte-run--circular-list-p arg))
|
||||
(hash (and round (gethash arg byte-run--ssp-seen))))
|
||||
(or hash
|
||||
(let ((a arg) new)
|
||||
(while
|
||||
(progn
|
||||
(when round
|
||||
(puthash a new byte-run--ssp-seen))
|
||||
(setq new (byte-run--strip-s-p-1 (car a)))
|
||||
(when (not (eq new (car a))) ; For read-only things.
|
||||
(setcar a new))
|
||||
(and (consp (cdr a))
|
||||
(not
|
||||
(setq hash
|
||||
(and round
|
||||
(gethash (cdr a) byte-run--ssp-seen))))))
|
||||
(setq a (cdr a)))
|
||||
(setq new (byte-run--strip-s-p-1 (cdr a)))
|
||||
(when (not (eq new (cdr a)))
|
||||
(setcdr a (or hash new)))
|
||||
arg))))
|
||||
|
||||
((or (vectorp arg) (recordp arg))
|
||||
(let ((hash (gethash arg byte-run--ssp-seen)))
|
||||
(or hash
|
||||
(let* ((len (length arg))
|
||||
(i 0)
|
||||
new)
|
||||
(puthash arg arg byte-run--ssp-seen)
|
||||
(while (< i len)
|
||||
(setq new (byte-run--strip-s-p-1 (aref arg i)))
|
||||
(when (not (eq new (aref arg i)))
|
||||
(aset arg i new))
|
||||
(setq i (1+ i)))
|
||||
arg))))
|
||||
|
||||
(t arg))))
|
||||
|
||||
(defalias 'byte-run-strip-symbol-positions
|
||||
#'(lambda (arg)
|
||||
(setq byte-run--ssp-seen (make-hash-table :test 'eq))
|
||||
(byte-run--strip-s-p-1 arg)))
|
||||
|
||||
(defalias 'function-put
|
||||
;; We don't want people to just use `put' because we can't conveniently
|
||||
;; hook into `put' to remap old properties to new ones. But for now, there's
|
||||
|
|
@ -38,7 +115,9 @@
|
|||
"Set FUNCTION's property PROP to VALUE.
|
||||
The namespace for PROP is shared with symbols.
|
||||
So far, FUNCTION can only be a symbol, not a lambda expression."
|
||||
(put function prop value)))
|
||||
(put (bare-symbol function)
|
||||
(byte-run-strip-symbol-positions prop)
|
||||
(byte-run-strip-symbol-positions value))))
|
||||
(function-put 'defmacro 'doc-string-elt 3)
|
||||
(function-put 'defmacro 'lisp-indent-function 2)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue