[Emacs-diffs] trunk r117011: * lisp/emacs-lisp/byte-run.el (function-put): New function.

[Stefan Monnier]

------------------------------------------------------------
revno: 117011
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2014-04-22 12:22:13 -0400
message:
  * 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.
modified:
  etc/NEWS                       news-20100311060928-aoit31wvzf25yr1z-1
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/byte-run.el    byterun.el-20091113204419-o5vbwnq5f7feedwu-2586
  lisp/emacs-lisp/cl-macs.el     clmacs.el-20091113204419-o5vbwnq5f7feedwu-612

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2014-04-22 03:18:15 +0000
+++ b/etc/NEWS  2014-04-22 16:22:13 +0000
@@ -95,9 +95,14 @@
 
 * 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'.
 

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-04-22 07:04:34 +0000
+++ b/lisp/ChangeLog    2014-04-22 16:22:13 +0000
@@ -1,7 +1,15 @@
+2014-04-22  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
-       * 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  <address@hidden>  (tiny change)
 

=== modified file 'lisp/emacs-lisp/byte-run.el'
--- a/lisp/emacs-lisp/byte-run.el       2014-04-22 07:04:34 +0000
+++ b/lisp/emacs-lisp/byte-run.el       2014-04-22 16:22:13 +0000
@@ -84,22 +84,36 @@
                    (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 @@
 
 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

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el        2014-04-22 03:51:12 +0000
+++ b/lisp/emacs-lisp/cl-macs.el        2014-04-22 16:22:13 +0000
@@ -2589,7 +2589,7 @@
              (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 @@
   "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 @@
 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 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 @@
                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 @@
   ;; 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 @@
   (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)