rm lazy macro use

[bpt/emacs.git] / lisp / emacs-lisp / byte-run.el

diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 635eef9..b9fc8d8 100644 (file)
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -1,10 +1,10 @@
 ;;; byte-run.el --- byte-compiler support for inlining  -*- lexical-binding: t -*-
 
 ;;; byte-run.el --- byte-compiler support for inlining  -*- lexical-binding: t -*-
 

-;; Copyright (C) 1992, 2001-2012  Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2014 Free Software Foundation, Inc.

 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>

-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org

 ;; Keywords: internal
 ;; Package: emacs
 
 ;; Keywords: internal
 ;; Package: emacs
 


@@ -30,6 +30,17 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(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
+  ;; no such remapping, so we just call `put'.
+  #'(lambda (f prop value) (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.")
+(function-put 'defmacro 'doc-string-elt 3)
+(function-put 'defmacro 'lisp-indent-function 2)
+

 ;; `macro-declaration-function' are both obsolete (as marked at the end of this
 ;; file) but used in many .elc files.
 
 ;; `macro-declaration-function' are both obsolete (as marked at the end of this
 ;; file) but used in many .elc files.
 


@@ -69,53 +80,82 @@ The return value of this function is not used."
 ;; handle declarations in macro definitions and this is the first file
 ;; loaded by loadup.el that uses declarations in macros.
 
 ;; handle declarations in macro definitions and this is the first file
 ;; loaded by loadup.el that uses declarations in macros.
 

-(defvar defun-declarations-alist
-  (list
-   ;; We can only use backquotes inside the lambdas and not for those
-   ;; properties that are used by functions loaded before backquote.el.
-   (list 'advertised-calling-convention
-         #'(lambda (f _args arglist when)
-             (list 'set-advertised-calling-convention
-                   (list 'quote f) (list 'quote arglist) (list 'quote when))))
-   (list 'obsolete
-         #'(lambda (f _args new-name when)
-             `(make-obsolete ',f ',new-name ,when)))
-   (list 'compiler-macro
-         #'(lambda (f _args compiler-function)
-             `(put ',f 'compiler-macro #',compiler-function)))
-   (list 'doc-string
-         #'(lambda (f _args pos)
-             (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos))))
-   (list 'indent
-         #'(lambda (f _args val)
-             (list 'put (list 'quote f)
-                   ''lisp-indent-function (list 'quote val)))))
-  "List associating function properties to their macro expansion.
+;; Add any new entries to info node `(elisp)Declare Form'.
+(eval-and-compile
+  (defvar defun-declarations-alist
+    (list
+     ;; We can only use backquotes inside the lambdas and not for those
+     ;; properties that are used by functions loaded before backquote.el.
+     (list 'advertised-calling-convention
+           #'(lambda (f _args arglist when)
+               (list 'set-advertised-calling-convention
+                     (list 'quote f) (list 'quote arglist) (list 'quote when))))
+     (list 'obsolete
+           #'(lambda (f _args new-name when)
+               (list 'make-obsolete
+                     (list 'quote f) (list 'quote new-name) (list 'quote when))))
+     (list 'interactive-only
+           #'(lambda (f _args 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
+                  (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 'function-put (list 'quote f)
+                     ''doc-string-elt (list 'quote pos))))
+     (list 'indent
+           #'(lambda (f _args val)
+               (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
 a function.  For each (PROP . VALUES) in a function's declaration,
 the FUN corresponding to PROP is called with the function name,
 the function's arglist, and the VALUES and should return the code to use
 Each element of the list takes the form (PROP FUN) where FUN is
 a function.  For each (PROP . VALUES) in a function's declaration,
 the FUN corresponding to PROP is called with the function name,
 the function's arglist, and the VALUES and should return the code to use

-to set this property.")
-
-(defvar macro-declarations-alist
-  (cons
-   (list 'debug
-         #'(lambda (name _args spec)
-             (list 'progn :autoload-end
-                   (list 'put (list 'quote name)
-                         ''edebug-form-spec (list 'quote spec)))))
-   defun-declarations-alist)
-  "List associating properties of macros to their macro expansion.
-Each element of the list takes the form (PROP FUN) where FUN is
-a function.  For each (PROP . VALUES) in a macro's declaration,
-the FUN corresponding to PROP is called with the function name
-and the VALUES and should return the code to use to set this property.")
+to set this property.
+
+This is used by `declare'.")
+
+  (defvar macro-declarations-alist
+    (cons
+     (list 'debug
+           #'(lambda (name _args spec)
+               (list 'progn :autoload-end
+                     (list 'put (list 'quote name)
+                           ''edebug-form-spec (list 'quote spec)))))
+     defun-declarations-alist)
+    "List associating properties of macros to their macro expansion.
+Each element of the list takes the form (PROP FUN) where FUN is a function.
+For each (PROP . VALUES) in a macro's declaration, the FUN corresponding
+to PROP is called with the macro name, the macro's arglist, and the VALUES
+and should return the code to use to set this property.
+
+This is used by `declare'."))

 
 

-(put 'defmacro 'doc-string-elt 3)

 (defalias 'defmacro
   (cons
    'macro
 (defalias 'defmacro
   (cons
    'macro

-   #'(lambda (name arglist &optional docstring decl &rest body)
+   #'(lambda (name arglist &optional docstring &rest body)

        "Define NAME as a macro.
 When the macro is called, as in (NAME ARGS...),
 the function (lambda ARGLIST BODY...) is applied to
        "Define NAME as a macro.
 When the macro is called, as in (NAME ARGS...),
 the function (lambda ARGLIST BODY...) is applied to


@@ -123,32 +163,39 @@ the list ARGS... as it appears in the expression,
 and the result should be a form to be evaluated instead of the original.
 DECL is a declaration, optional, of the form (declare DECLS...) where
 DECLS is a list of elements of the form (PROP . VALUES).  These are
 and the result should be a form to be evaluated instead of the original.
 DECL is a declaration, optional, of the form (declare DECLS...) where
 DECLS is a list of elements of the form (PROP . VALUES).  These are

-interpreted according to `macro-declarations-alist'."
-       (if (stringp docstring) nil
-         (if decl (setq body (cons decl body)))
-         (setq decl docstring)
-         (setq docstring nil))
-       (if (or (null decl) (eq 'declare (car-safe decl))) nil
-         (setq body (cons decl body))
-         (setq decl nil))
-       (if (null body) (setq body '(nil)))
-       (if docstring (setq body (cons docstring body)))
-       ;; Can't use backquote because it's not defined yet!
-       (let* ((fun (list 'function (cons 'lambda (cons arglist body))))
-              (def (list 'defalias
-                         (list 'quote name)
-                         (list 'cons ''macro fun)))
-              (declarations
-               (mapcar
-                #'(lambda (x)
-                    (let ((f (cdr (assq (car x) macro-declarations-alist))))
-                      (if f (apply (car f) name arglist (cdr x))
-                        (message "Warning: Unknown macro property %S in %S"
-                                 (car x) name))))
-                (cdr decl))))
-         (if declarations
-             (cons 'prog1 (cons def declarations))
-           def)))))
+interpreted according to `macro-declarations-alist'.
+The return value is undefined.
+
+\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
+       ;; We can't just have `decl' as an &optional argument, because we need
+       ;; to distinguish
+       ;;    (defmacro foo (arg) (bar) nil)
+       ;; from
+       ;;    (defmacro foo (arg) (bar)).
+       (let ((decls (cond
+                    ((eq (car-safe docstring) 'declare)
+                     (prog1 (cdr docstring) (setq docstring nil)))
+                    ((and (stringp docstring)
+                          (eq (car-safe (car body)) 'declare))
+                     (prog1 (cdr (car body)) (setq body (cdr body)))))))
+        (if docstring (setq body (cons docstring body))
+          (if (null body) (setq body '(nil))))
+        ;; Can't use backquote because it's not defined yet!
+        (let* ((fun (list 'function (cons 'lambda (cons arglist body))))
+               (def (list 'defalias
+                          (list 'quote name)
+                          (list 'cons ''macro fun)))
+               (declarations
+                (mapcar
+                 #'(lambda (x)
+                     (let ((f (cdr (assq (car x) macro-declarations-alist))))
+                       (if f (apply (car f) name arglist (cdr x))
+                         (message "Warning: Unknown macro property %S in %S"
+                                  (car x) name))))
+                 decls)))
+           (if declarations
+               (cons 'prog1 (cons def declarations))
+             def))))))

 
 ;; Now that we defined defmacro we can use it!
 (defmacro defun (name arglist &optional docstring &rest body)
 
 ;; Now that we defined defmacro we can use it!
 (defmacro defun (name arglist &optional docstring &rest body)


@@ -158,6 +205,7 @@ See also the function `interactive'.
 DECL is a declaration, optional, of the form (declare DECLS...) where
 DECLS is a list of elements of the form (PROP . VALUES).  These are
 interpreted according to `defun-declarations-alist'.
 DECL is a declaration, optional, of the form (declare DECLS...) where
 DECLS is a list of elements of the form (PROP . VALUES).  These are
 interpreted according to `defun-declarations-alist'.

+The return value is undefined.

 
 \(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
   ;; We can't just have `decl' as an &optional argument, because we need
 
 \(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
   ;; We can't just have `decl' as an &optional argument, because we need


@@ -165,11 +213,12 @@ interpreted according to `defun-declarations-alist'.
   ;;    (defun foo (arg) (toto) nil)
   ;; from
   ;;    (defun foo (arg) (toto)).
   ;;    (defun foo (arg) (toto) nil)
   ;; from
   ;;    (defun foo (arg) (toto)).

-  (declare (doc-string 3))
+  (declare (doc-string 3) (indent 2))

   (let ((decls (cond
                 ((eq (car-safe docstring) 'declare)
                  (prog1 (cdr docstring) (setq docstring nil)))
   (let ((decls (cond
                 ((eq (car-safe docstring) 'declare)
                  (prog1 (cdr docstring) (setq docstring nil)))

-                ((eq (car-safe (car body)) 'declare)
+                ((and (stringp docstring)
+                     (eq (car-safe (car body)) 'declare))

                  (prog1 (cdr (car body)) (setq body (cdr body)))))))
     (if docstring (setq body (cons docstring body))
       (if (null body) (setq body '(nil))))
                  (prog1 (cdr (car body)) (setq body (cdr body)))))))
     (if docstring (setq body (cons docstring body))
       (if (null body) (setq body '(nil))))


@@ -183,11 +232,9 @@ interpreted according to `defun-declarations-alist'.
                    ((and (featurep 'cl)
                          (memq (car x)  ;C.f. cl-do-proclaim.
                                '(special inline notinline optimize warn)))
                    ((and (featurep 'cl)
                          (memq (car x)  ;C.f. cl-do-proclaim.
                                '(special inline notinline optimize warn)))

-                    (if (null (stringp docstring))
-                        (push (list 'declare x) body)
-                      (setcdr body (cons (list 'declare x) (cdr body))))
+                    (setq body (cons (list 'declare x) body))

                     nil)
                     nil)

-                   (t (message "Warning: Unknown defun property %S in %S"
+                   (t (message "Warning: Unknown defun property `%S' in %S"

                                (car x) name)))))
                    decls))
           (def (list 'defalias
                                (car x) name)))))
                    decls))
           (def (list 'defalias


@@ -195,13 +242,21 @@ interpreted according to `defun-declarations-alist'.
                      (list 'function
                            (cons 'lambda
                                  (cons arglist body))))))
                      (list 'function
                            (cons 'lambda
                                  (cons arglist body))))))

-      (if declarations
-          (cons 'prog1 (cons def declarations))
-        def))))
+      (list 'prog1
+            (if declarations
+                (cons 'prog1 (cons def declarations))
+              def)
+            (list 'funcall
+                  (list '@ '(guile) 'set-procedure-property!)
+                  (list 'symbol-function (list 'quote name))
+                  (list 'quote 'name)
+                  (list 'quote name))))))

 \f
 ;; Redefined in byte-optimize.el.
 ;; This is not documented--it's not clear that we should promote it.
 \f
 ;; Redefined in byte-optimize.el.
 ;; This is not documented--it's not clear that we should promote it.

-(fset 'inline 'progn)
+
+(defmacro inline (&rest body)
+  (cons 'progn body))

 
 ;;; Interface to inline functions.
 
 
 ;;; Interface to inline functions.
 


@@ -231,7 +286,8 @@ interpreted according to `defun-declarations-alist'.
 ;;             fns)))
 
 (defmacro defsubst (name arglist &rest body)
 ;;             fns)))
 
 (defmacro defsubst (name arglist &rest body)

-  "Define an inline function.  The syntax is just like that of `defun'."
+  "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))
   (or (memq (get name 'byte-optimizer)
            '(nil byte-compile-inline-expand))
   (declare (debug defun) (doc-string 3))
   (or (memq (get name 'byte-optimizer)
            '(nil byte-compile-inline-expand))


@@ -252,7 +308,9 @@ convention was modified."
            advertised-signature-table))
 
 (defun make-obsolete (obsolete-name current-name &optional when)
            advertised-signature-table))
 
 (defun make-obsolete (obsolete-name current-name &optional when)

-  "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
+  "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
+OBSOLETE-NAME should be a function name or macro name (a symbol).
+

 The warning will say that CURRENT-NAME should be used instead.
 If CURRENT-NAME is a string, that is the `use instead' message
 \(it should end with a period, and not start with a capital).
 The warning will say that CURRENT-NAME should be used instead.
 If CURRENT-NAME is a string, that is the `use instead' message
 \(it should end with a period, and not start with a capital).


@@ -261,7 +319,6 @@ was first made obsolete, for example a date or a release number."
   (declare (advertised-calling-convention
             ;; New code should always provide the `when' argument.
             (obsolete-name current-name when) "23.1"))
   (declare (advertised-calling-convention
             ;; New code should always provide the `when' argument.
             (obsolete-name current-name when) "23.1"))

-  (interactive "aMake function obsolete: \nxObsoletion replacement: ")

   (put obsolete-name 'byte-obsolete-info
        ;; The second entry used to hold the `byte-compile' handler, but
        ;; is not used any more nowadays.
   (put obsolete-name 'byte-obsolete-info
        ;; The second entry used to hold the `byte-compile' handler, but
        ;; is not used any more nowadays.


@@ -311,7 +368,7 @@ This uses `defvaralias' and `make-obsolete-variable' (which see).
 See the Info node `(elisp)Variable Aliases' for more details.
 
 If CURRENT-NAME is a defcustom (more generally, any variable
 See the Info node `(elisp)Variable Aliases' for more details.
 
 If CURRENT-NAME is a defcustom (more generally, any variable

-where OBSOLETE-NAME may be set, e.g. in a .emacs file, before the
+where OBSOLETE-NAME may be set, e.g. in an init file, before the

 alias is defined), then the define-obsolete-variable-alias
 statement should be evaluated before the defcustom, if user
 customizations are to be respected.  The simplest way to achieve
 alias is defined), then the define-obsolete-variable-alias
 statement should be evaluated before the defcustom, if user
 customizations are to be respected.  The simplest way to achieve


@@ -355,7 +412,7 @@ obsolete."
 (defmacro dont-compile (&rest body)
   "Like `progn', but the body always runs interpreted (not compiled).
 If you think you need this, you're probably making a mistake somewhere."
 (defmacro dont-compile (&rest body)
   "Like `progn', but the body always runs interpreted (not compiled).
 If you think you need this, you're probably making a mistake somewhere."

-  (declare (debug t) (indent 0))
+  (declare (debug t) (indent 0) (obsolete nil "24.4"))

   (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body)))))
 
 \f
   (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body)))))
 
 \f


@@ -366,22 +423,29 @@ If you think you need this, you're probably making a mistake somewhere."
 
 (defmacro eval-when-compile (&rest body)
   "Like `progn', but evaluates the body at compile time if you're compiling.
 
 (defmacro eval-when-compile (&rest body)
   "Like `progn', but evaluates the body at compile time if you're compiling.

-Thus, the result of the body appears to the compiler as a quoted constant.
-In interpreted code, this is entirely equivalent to `progn'."
-  (declare (debug t) (indent 0))
-  ;; Not necessary because we have it in b-c-initial-macro-environment
-  ;; (list 'quote (eval (cons 'progn body)))
-  (cons 'progn body))
+Thus, the result of the body appears to the compiler as a quoted
+constant.  In interpreted code, this is entirely equivalent to
+`progn', except that the value of the expression may be (but is
+not necessarily) computed at load time if eager macro expansion
+is enabled."
+  (declare (debug (&rest def-form)) (indent 0))
+  (list 'quote (eval (cons 'progn body) lexical-binding)))

 
 (defmacro eval-and-compile (&rest body)
 
 (defmacro eval-and-compile (&rest body)

-  "Like `progn', but evaluates the body at compile time and at load time."
+  "Like `progn', but evaluates the body at compile time and at
+load time.  In interpreted code, this is entirely equivalent to
+`progn', except that the value of the expression may be (but is
+not necessarily) computed at load time if eager macro expansion
+is enabled."

   (declare (debug t) (indent 0))
   (declare (debug t) (indent 0))

-  ;; Remember, it's magic.
-  (cons 'progn body))
+  ;; When the byte-compiler expands code, this macro is not used, so we're
+  ;; either about to run `body' (plain interpretation) or we're doing eager
+  ;; macroexpansion.
+  (list 'quote (eval (cons 'progn body) lexical-binding)))

 
 

-(put 'with-no-warnings 'lisp-indent-function 0)

 (defun with-no-warnings (&rest body)
   "Like `progn', but prevents compiler warnings in the body."
 (defun with-no-warnings (&rest body)
   "Like `progn', but prevents compiler warnings in the body."

+  (declare (indent 0))

   ;; The implementation for the interpreter is basically trivial.
   (car (last body)))
 
   ;; The implementation for the interpreter is basically trivial.
   (car (last body)))
 


@@ -418,8 +482,8 @@ In interpreted code, this is entirely equivalent to `progn'."
 ;;   nil)
 
 (make-obsolete-variable 'macro-declaration-function
 ;;   nil)
 
 (make-obsolete-variable 'macro-declaration-function

-                        'macro-declarations-alist "24.2")
+                        'macro-declarations-alist "24.3")

 (make-obsolete 'macro-declaration-function
 (make-obsolete 'macro-declaration-function

-               'macro-declarations-alist "24.2")
+               'macro-declarations-alist "24.3")

 
 ;;; byte-run.el ends here
 
 ;;; byte-run.el ends here