diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/byte-run.el | 45 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 17 |
2 files changed, 41 insertions, 21 deletions
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index be011e2146c..e5f8feb888b 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -84,22 +84,36 @@ The return value of this function is not used." (list 'quote f) (list 'quote new-name) (list 'quote when)))) (list 'interactive-only #'(lambda (f _args instead) - (list 'put (list 'quote f) ''interactive-only - (list 'quote instead)))) + (list 'function-put (list 'quote f) + ''interactive-only (list 'quote instead)))) + ;; FIXME: Merge `pure' and `side-effect-free'. + (list 'pure + #'(lambda (f _args val) + (list 'function-put (list 'quote f) + ''pure (list 'quote val))) + "If non-nil, the compiler can replace calls with their return value. +This may shift errors from run-time to compile-time.") + (list 'side-effect-free + #'(lambda (f _args val) + (list 'function-put (list 'quote f) + ''side-effect-free (list 'quote val))) + "If non-nil, calls can be ignored if their value is unused. +If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") (list 'compiler-macro #'(lambda (f args compiler-function) `(eval-and-compile - (put ',f 'compiler-macro - ,(if (eq (car-safe compiler-function) 'lambda) - `(lambda ,(append (cadr compiler-function) args) - ,@(cddr compiler-function)) - `#',compiler-function))))) + (function-put ',f 'compiler-macro + ,(if (eq (car-safe compiler-function) 'lambda) + `(lambda ,(append (cadr compiler-function) args) + ,@(cddr compiler-function)) + `#',compiler-function))))) (list 'doc-string #'(lambda (f _args pos) - (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) + (list 'function-put (list 'quote f) + ''doc-string-elt (list 'quote pos)))) (list 'indent #'(lambda (f _args val) - (list 'put (list 'quote f) + (list 'function-put (list 'quote f) ''lisp-indent-function (list 'quote val))))) "List associating function properties to their macro expansion. Each element of the list takes the form (PROP FUN) where FUN is @@ -126,8 +140,17 @@ and should return the code to use to set this property. This is used by `declare'.") -(put 'defmacro 'doc-string-elt 3) -(put 'defmacro 'lisp-indent-function 2) +(defun function-put (f prop value) + "Set function F's property PROP to VALUE. +The namespace for PROP is shared with symbols. +So far, F can only be a symbol, not a lambda expression." + ;; 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 + ;; no such remapping, so we just call `put'. + (put f prop value)) + +(function-put 'defmacro 'doc-string-elt 3) +(function-put 'defmacro 'lisp-indent-function 2) (defalias 'defmacro (cons 'macro diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 47a89d0880b..fe064b81e31 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2589,7 +2589,7 @@ non-nil value, that slot cannot be set via `setf'. (put ',name 'cl-struct-include ',include) (put ',name 'cl-struct-print ,print-auto) ,@(mapcar (lambda (x) - `(put ',(car x) 'side-effect-free ',(cdr x))) + `(function-put ',(car x) 'side-effect-free ',(cdr x))) side-eff)) forms) `(progn ,@(nreverse (cons `',name forms))))) @@ -2598,9 +2598,8 @@ non-nil value, that slot cannot be set via `setf'. "Return the sequence used to build STRUCT-TYPE. STRUCT-TYPE is a symbol naming a struct type. Return 'vector or 'list, or nil if STRUCT-TYPE is not a struct type. " + (declare (side-effect-free t) (pure t)) (car (get struct-type 'cl-struct-type))) -(put 'cl-struct-sequence-type 'side-effect-free t) -(put 'cl-struct-sequence-type 'pure t) (defun cl-struct-slot-info (struct-type) "Return a list of slot names of struct STRUCT-TYPE. @@ -2608,9 +2607,8 @@ Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a slot name symbol and OPTS is a list of slot options given to `cl-defstruct'. Dummy slots that represent the struct name and slots skipped by :initial-offset may appear in the list." + (declare (side-effect-free t) (pure t)) (get struct-type 'cl-struct-slots)) -(put 'cl-struct-slot-info 'side-effect-free t) -(put 'cl-struct-slot-info 'pure t) (defun cl-struct-slot-offset (struct-type slot-name) "Return the offset of slot SLOT-NAME in STRUCT-TYPE. @@ -2618,12 +2616,11 @@ The returned zero-based slot index is relative to the start of the structure data type and is adjusted for any structure name and :initial-offset slots. Signal error if struct STRUCT-TYPE does not contain SLOT-NAME." + (declare (side-effect-free t) (pure t)) (or (cl-position slot-name (cl-struct-slot-info struct-type) :key #'car :test #'eq) (error "struct %s has no slot %s" struct-type slot-name))) -(put 'cl-struct-slot-offset 'side-effect-free t) -(put 'cl-struct-slot-offset 'pure t) (defvar byte-compile-function-environment) (defvar byte-compile-macro-environment) @@ -2913,13 +2910,13 @@ The function's arguments should be treated as immutable. cl-notevery cl-revappend cl-nreconc gethash)) ;;; Things that are side-effect-free. -(mapc (lambda (x) (put x 'side-effect-free t)) +(mapc (lambda (x) (function-put x 'side-effect-free t)) '(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd cl-lcm cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem cl-subseq cl-list-length cl-get cl-getf)) ;;; Things that are side-effect-and-error-free. -(mapc (lambda (x) (put x 'side-effect-free 'error-free)) +(mapc (lambda (x) (function-put x 'side-effect-free 'error-free)) '(eql cl-list* cl-subst cl-acons cl-equalp cl-random-state-p copy-tree cl-sublis)) @@ -2942,6 +2939,7 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." ;; and a gv-expander "for free". "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE. STRUCT and SLOT-NAME are symbols. INST is a structure instance." + (declare (side-effect-free t)) (unless (cl-typep inst struct-type) (signal 'wrong-type-argument (list struct-type inst))) ;; We could use `elt', but since the byte compiler will resolve the @@ -2950,7 +2948,6 @@ STRUCT and SLOT-NAME are symbols. INST is a structure instance." (if (eq (cl-struct-sequence-type struct-type) 'vector) (aref inst (cl-struct-slot-offset struct-type slot-name)) (nth (cl-struct-slot-offset struct-type slot-name) inst))) -(put 'cl-struct-slot-value 'side-effect-free t) (run-hooks 'cl-macs-load-hook) |