rm lazy macro use
[bpt/emacs.git] / lisp / emacs-lisp / byte-run.el
index 635eef9..b9fc8d8 100644 (file)
@@ -1,10 +1,10 @@
 ;;; byte-run.el --- byte-compiler support for inlining  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1992, 2001-201 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>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: internal
 ;; Package: emacs
 
 
 ;;; 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.
 
@@ -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.
 
-(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
-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
-   #'(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
@@ -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
-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)
@@ -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'.
+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
@@ -165,11 +213,12 @@ interpreted according to `defun-declarations-alist'.
   ;;    (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)))
-                ((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))))
@@ -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)))
-                    (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)
-                   (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
@@ -195,13 +242,21 @@ interpreted according to `defun-declarations-alist'.
                      (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.
-(fset 'inline 'progn)
+
+(defmacro inline (&rest body)
+  (cons 'progn body))
 
 ;;; Interface to inline functions.
 
@@ -231,7 +286,8 @@ interpreted according to `defun-declarations-alist'.
 ;;             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))
@@ -252,7 +308,9 @@ convention was modified."
            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).
@@ -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"))
-  (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.
@@ -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
-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
@@ -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."
-  (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
@@ -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.
-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)
-  "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))
-  ;; 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."
+  (declare (indent 0))
   ;; 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
-                        'macro-declarations-alist "24.2")
+                        'macro-declarations-alist "24.3")
 (make-obsolete 'macro-declaration-function
-               'macro-declarations-alist "24.2")
+               'macro-declarations-alist "24.3")
 
 ;;; byte-run.el ends here