From 67c477ae67ae3e83b027fb03c5d11f47fa30566c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 22 Apr 2014 12:22:13 -0400 Subject: [PATCH] * lisp/emacs-lisp/byte-run.el (function-put): New function. (defun-declarations-alist): Use it. Add `pure' and `side-effect-free'. * lisp/emacs-lisp/cl-macs.el (cl-defstruct, cl-struct-sequence-type) (cl-struct-slot-info, cl-struct-slot-offset, cl-struct-slot-value): Use them. --- etc/NEWS | 9 ++++++-- lisp/ChangeLog | 20 ++++++++++++----- lisp/emacs-lisp/byte-run.el | 45 ++++++++++++++++++++++++++++--------- lisp/emacs-lisp/cl-macs.el | 17 ++++++-------- 4 files changed, 62 insertions(+), 29 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 24f96ee68f7..3f9c47b33f3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -95,9 +95,14 @@ active region handling. * Lisp Changes in Emacs 24.5 +** New function `function-put' to use instead of `put' for function properties. + +++ -** You can specify a function's interactive-only property via `declare'. -However you specify it, the property affects `describe-function' output. +** New properties that can be specified with `declare': +*** (interactive-only INSTEAD), tells to use INSTEAD for non-interactive use. +*** (pure VAL), if VAL is non-nil, indicates the function is pure. +*** (side-effect-free VAL), if VAL is non-nil, indicates the function does not +have side effects. ** You can access the slots of structures using `cl-struct-slot-value'. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 06e2732becc..54e1933ecf0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,15 @@ +2014-04-22 Stefan Monnier + + * emacs-lisp/byte-run.el (function-put): New function. + (defun-declarations-alist): Use it. Add `pure' and `side-effect-free'. + * emacs-lisp/cl-macs.el (cl-defstruct, cl-struct-sequence-type) + (cl-struct-slot-info, cl-struct-slot-offset, cl-struct-slot-value): + Use them. + 2014-04-22 Daniel Colascione - * emacs-lisp/macroexp.el (internal-macroexpand-for-load): Add - `full-p' parameter; when nil, call `macroexpand' instead of + * emacs-lisp/macroexp.el (internal-macroexpand-for-load): + Add `full-p' parameter; when nil, call `macroexpand' instead of `macroexpand-all'. * emacs-lisp/byte-run.el (eval-when-compile, eval-and-compile): @@ -102,8 +110,8 @@ (xterm-mouse-tracking-enable-sequence) (xterm-mouse-tracking-disable-sequence): New constants. (turn-on-xterm-mouse-tracking-on-terminal) - (turn-off-xterm-mouse-tracking-on-terminal): Use - tty-mode-set-strings and tty-mode-reset-strings terminal + (turn-off-xterm-mouse-tracking-on-terminal): + Use tty-mode-set-strings and tty-mode-reset-strings terminal parameters instead of random hooks. (turn-on-xterm-mouse-tracking) (turn-off-xterm-mouse-tracking): Delete. @@ -121,8 +129,8 @@ (xterm-turn-off-modify-other-keys) (xterm-remove-modify-other-keys): Delete obsolete functions. - * term/screen.el: Rewrite to just use the xterm code. Add - copyright notice. Mention tmux. + * term/screen.el: Rewrite to just use the xterm code. + Add copyright notice. Mention tmux. 2014-04-17 Ian D (tiny change) 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) -- 2.39.2