* 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.

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  <monnier@iro.umontreal.ca>
+
+        * 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  <dancol@dancol.org>
 
-        * 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  <dunni@gnu.org>  (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)