-;;; byte-run.el --- byte-compiler support for inlining
+;;; byte-run.el --- byte-compiler support for inlining -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;;; Code:
-;; We define macro-declaration-function here because it is needed to
-;; handle declarations in macro definitions and this is the first file
-;; loaded by loadup.el that uses declarations in macros.
+;; `macro-declaration-function' are both obsolete (as marked at the end of this
+;; file) but used in many .elc files.
+
+(defvar macro-declaration-function #'macro-declaration-function
+ "Function to process declarations in a macro definition.
+The function will be called with two args MACRO and DECL.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The value the function returns is not used.")
-(defun macro-declaration-function (macro decl)
- "Process a declaration found in a macro definition.
+(defalias 'macro-declaration-function
+ #'(lambda (macro decl)
+ "Process a declaration found in a macro definition.
This is set as the value of the variable `macro-declaration-function'.
MACRO is the name of the macro being defined.
DECL is a list `(declare ...)' containing the declarations.
The return value of this function is not used."
- ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
- (let (d)
- ;; Ignore the first element of `decl' (it's always `declare').
- (while (setq decl (cdr decl))
- (setq d (car decl))
- (if (and (consp d)
- (listp (cdr d))
- (null (cdr (cdr d))))
- (cond ((eq (car d) 'indent)
- (put macro 'lisp-indent-function (car (cdr d))))
- ((eq (car d) 'debug)
- (put macro 'edebug-form-spec (car (cdr d))))
- ((eq (car d) 'doc-string)
- (put macro 'doc-string-elt (car (cdr d))))
- (t
- (message "Unknown declaration %s" d)))
- (message "Invalid declaration %s" d)))))
-
-
-(setq macro-declaration-function 'macro-declaration-function)
+ ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
+ (let (d)
+ ;; Ignore the first element of `decl' (it's always `declare').
+ (while (setq decl (cdr decl))
+ (setq d (car decl))
+ (if (and (consp d)
+ (listp (cdr d))
+ (null (cdr (cdr d))))
+ (cond ((eq (car d) 'indent)
+ (put macro 'lisp-indent-function (car (cdr d))))
+ ((eq (car d) 'debug)
+ (put macro 'edebug-form-spec (car (cdr d))))
+ ((eq (car d) 'doc-string)
+ (put macro 'doc-string-elt (car (cdr d))))
+ (t
+ (message "Unknown declaration %s" d)))
+ (message "Invalid declaration %s" d))))))
+
+;; We define macro-declaration-alist here because it is needed to
+;; 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.
+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.")
+
+(put 'defmacro 'doc-string-elt 3)
+(defalias 'defmacro
+ (cons
+ 'macro
+ #'(lambda (name arglist &optional docstring decl &rest body)
+ "Define NAME as a macro.
+When the macro is called, as in (NAME ARGS...),
+the function (lambda ARGLIST BODY...) is applied to
+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'.
+The return value is undefined."
+ (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)))))
+
+;; Now that we defined defmacro we can use it!
+(defmacro defun (name arglist &optional docstring &rest body)
+ "Define NAME as a function.
+The definition is (lambda ARGLIST [DOCSTRING] BODY...).
+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
+ ;; to distinguish
+ ;; (defun foo (arg) (toto) nil)
+ ;; from
+ ;; (defun foo (arg) (toto)).
+ (declare (doc-string 3))
+ (let ((decls (cond
+ ((eq (car-safe docstring) 'declare)
+ (prog1 (cdr docstring) (setq docstring nil)))
+ ((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))))
+ (let ((declarations
+ (mapcar
+ #'(lambda (x)
+ (let ((f (cdr (assq (car x) defun-declarations-alist))))
+ (cond
+ (f (apply (car f) name arglist (cdr x)))
+ ;; Yuck!!
+ ((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))))
+ nil)
+ (t (message "Warning: Unknown defun property %S in %S"
+ (car x) name)))))
+ decls))
+ (def (list 'defalias
+ (list 'quote name)
+ (list 'function
+ (cons 'lambda
+ (cons arglist body))))))
+ (if declarations
+ (cons 'prog1 (cons def declarations))
+ def))))
\f
;; Redefined in byte-optimize.el.
;; This is not documented--it's not clear that we should promote it.
;; "Cause the named functions to be open-coded when called from compiled code.
;; They will only be compiled open-coded when byte-compile-optimize is true."
;; (cons 'eval-and-compile
-;; (mapcar '(lambda (x)
+;; (mapcar (lambda (x)
;; (or (memq (get x 'byte-optimizer)
;; '(nil byte-compile-inline-expand))
;; (error
;; (defmacro proclaim-notinline (&rest fns)
;; "Cause the named functions to no longer be open-coded."
;; (cons 'eval-and-compile
-;; (mapcar '(lambda (x)
+;; (mapcar (lambda (x)
;; (if (eq (get x 'byte-optimizer) 'byte-compile-inline-expand)
;; (put x 'byte-optimizer nil))
;; (list 'if (list 'eq (list 'get (list 'quote x) ''byte-optimizer)
;; (list 'put x ''byte-optimizer nil)))
;; fns)))
-;; This has a special byte-hunk-handler in bytecomp.el.
(defmacro defsubst (name arglist &rest body)
"Define an inline function. The syntax is just like that of `defun'."
- (declare (debug defun))
+ (declare (debug defun) (doc-string 3))
(or (memq (get name 'byte-optimizer)
'(nil byte-compile-inline-expand))
(error "`%s' is a primitive" name))
(defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key))
-(defun set-advertised-calling-convention (function signature when)
+(defun set-advertised-calling-convention (function signature _when)
"Set the advertised SIGNATURE of FUNCTION.
This will allow the byte-compiler to warn the programmer when she uses
an obsolete calling convention. WHEN specifies since when the calling
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).
-If provided, WHEN should be a string indicating when the function
+WHEN should be a string indicating when the function
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: ")
- (let ((handler (get obsolete-name 'byte-compile)))
- (if (eq 'byte-compile-obsolete handler)
- (setq handler (nth 1 (get obsolete-name 'byte-obsolete-info)))
- (put obsolete-name 'byte-compile 'byte-compile-obsolete))
- (put obsolete-name 'byte-obsolete-info
- (list (purecopy current-name) handler (purecopy when))))
+ (put obsolete-name 'byte-obsolete-info
+ ;; The second entry used to hold the `byte-compile' handler, but
+ ;; is not used any more nowadays.
+ (purecopy (list current-name nil when)))
obsolete-name)
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'make-obsolete '(obsolete-name current-name when) "23.1")
(defmacro define-obsolete-function-alias (obsolete-name current-name
&optional when docstring)
\(make-obsolete 'old-fun 'new-fun \"22.1\")
See the docstrings of `defalias' and `make-obsolete' for more details."
- (declare (doc-string 4))
+ (declare (doc-string 4)
+ (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional docstring) "23.1"))
`(progn
(defalias ,obsolete-name ,current-name ,docstring)
(make-obsolete ,obsolete-name ,current-name ,when)))
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'define-obsolete-function-alias
- '(obsolete-name current-name when &optional docstring) "23.1")
-(defun make-obsolete-variable (obsolete-name current-name &optional when)
+(defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message.
-If provided, WHEN should be a string indicating when the variable
-was first made obsolete, for example a date or a release number."
- (interactive
- (list
- (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t)))
- (if (equal str "") (error ""))
- (intern str))
- (car (read-from-string (read-string "Obsoletion replacement: ")))))
+WHEN should be a string indicating when the variable
+was first made obsolete, for example a date or a release number.
+ACCESS-TYPE if non-nil should specify the kind of access that will trigger
+ obsolescence warnings; it can be either `get' or `set'."
+ (declare (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional access-type) "23.1"))
(put obsolete-name 'byte-obsolete-variable
- (cons
- (if (stringp current-name)
- (purecopy current-name)
- current-name) (purecopy when)))
+ (purecopy (list current-name access-type when)))
obsolete-name)
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'make-obsolete-variable '(obsolete-name current-name when) "23.1")
+
(defmacro define-obsolete-variable-alias (obsolete-name current-name
&optional when docstring)
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
'saved-value, 'saved-variable-comment."
- (declare (doc-string 4))
+ (declare (doc-string 4)
+ (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional docstring) "23.1"))
`(progn
(defvaralias ,obsolete-name ,current-name ,docstring)
;; See Bug#4706.
(null (get ,current-name prop))
(put ,current-name prop (get ,obsolete-name prop))))
(make-obsolete-variable ,obsolete-name ,current-name ,when)))
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'define-obsolete-variable-alias
- '(obsolete-name current-name when &optional docstring) "23.1")
;; FIXME This is only defined in this file because the variable- and
;; function- versions are too. Unlike those two, this one is not used
;; (file-format emacs19))"
;; nil)
-;; arch-tag: 76f8328a-1f66-4df2-9b6d-5c3666dc05e9
+(make-obsolete-variable 'macro-declaration-function
+ 'macro-declarations-alist "24.3")
+(make-obsolete 'macro-declaration-function
+ 'macro-declarations-alist "24.3")
+
;;; byte-run.el ends here