diff options
Diffstat (limited to 'lisp/emacs-lisp/byte-run.el')
| -rw-r--r-- | lisp/emacs-lisp/byte-run.el | 73 |
1 files changed, 65 insertions, 8 deletions
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 77e077f0442..c542c550169 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -30,6 +30,60 @@ ;;; 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--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* ((hash (gethash arg byte-run--ssp-seen))) + (if hash ; Already processed this node. + arg + (let ((a arg) new) + (while + (progn + (puthash a t byte-run--ssp-seen) + (setq new (byte-run--strip-s-p-1 (car a))) + (setcar a new) + (and (consp (cdr a)) + (not + (setq hash (gethash (cdr a) byte-run--ssp-seen))))) + (setq a (cdr a))) + (setq new (byte-run--strip-s-p-1 (cdr a))) + (setcdr a new) + arg)))) + + ((or (vectorp arg) (recordp arg)) + (let ((hash (gethash arg byte-run--ssp-seen))) + (if hash + arg + (let* ((len (length arg)) + (i 0) + new) + (puthash arg t byte-run--ssp-seen) + (while (< i len) + (setq new (byte-run--strip-s-p-1 (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 +92,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) @@ -134,6 +190,7 @@ The return value of this function is not used." :autoload-end (eval-and-compile (defun ,cfname (,@(car data) ,@args) + (ignore ,@(delq '&rest (delq '&optional (copy-sequence args)))) ,@(cdr data)))))))) (defalias 'byte-run--set-doc-string @@ -253,11 +310,11 @@ The return value is undefined. #'(lambda (x) (let ((f (cdr (assq (car x) macro-declarations-alist)))) (if f (apply (car f) name arglist (cdr x)) - (macroexp-warn-and-return + (macroexp-warn-and-return (format-message "Unknown macro property %S in %S" (car x) name) - nil)))) + nil nil nil (car x))))) decls))) ;; Refresh font-lock if this is a new macro, or it is an ;; existing macro whose 'no-font-lock-keyword declaration @@ -329,7 +386,7 @@ The return value is undefined. (macroexp-warn-and-return (format-message "Unknown defun property `%S' in %S" (car x) name) - nil))))) + nil nil nil (car x)))))) decls)) (def (list 'defalias (list 'quote name) @@ -380,7 +437,7 @@ You don't need this. (See bytecomp.el commentary for more details.) "Define an inline function. The syntax is just like that of `defun'. \(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)" - (declare (debug defun) (doc-string 3)) + (declare (debug defun) (doc-string 3) (indent 2)) (or (memq (get name 'byte-optimizer) '(nil byte-compile-inline-expand)) (error "`%s' is a primitive" name)) @@ -434,7 +491,7 @@ WHEN should be a string indicating when the function was first made obsolete, for example a date or a release number. See the docstrings of `defalias' and `make-obsolete' for more details." - (declare (doc-string 4)) + (declare (doc-string 4) (indent defun)) `(progn (defalias ,obsolete-name ,current-name ,docstring) (make-obsolete ,obsolete-name ,current-name ,when))) @@ -483,7 +540,7 @@ For the benefit of Customize, if OBSOLETE-NAME has any of the following properties, they are copied to CURRENT-NAME, if it does not already have them: `saved-value', `saved-variable-comment'." - (declare (doc-string 4)) + (declare (doc-string 4) (indent defun)) `(progn (defvaralias ,obsolete-name ,current-name ,docstring) ;; See Bug#4706. @@ -574,7 +631,7 @@ For the `mapcar' case, only the `mapcar' function can be used in the symbol list. For `suspicious', only `set-buffer' can be used." ;; Note: during compilation, this definition is overridden by the one in ;; byte-compile-initial-macro-environment. - (declare (debug (sexp &optional body)) (indent 1)) + (declare (debug (sexp body)) (indent 1)) (if (not (and (featurep 'macroexp) (boundp 'byte-compile--suppressed-warnings))) ;; If `macroexp' is not yet loaded, we're in the middle of |