;;; byte-run.el --- byte-compiler support for inlining -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
#'(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)))
+ #'(lambda (f args compiler-function)
+ ;; FIXME: Make it possible to just reuse `args'.
+ `(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)))))
(list 'doc-string
#'(lambda (f _args pos)
(list 'put (list 'quote f) ''doc-string-elt (list 'quote pos))))
(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
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)))))
+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)
(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))))
((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))))
+ (push (list 'declare x)
+ (if (stringp docstring)
+ (if (eq (car-safe (cadr body)) 'interactive)
+ (cddr body)
+ (cdr body))
+ (if (eq (car-safe (car body)) 'interactive)
+ (cdr body)
+ 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
;; 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))
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).
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
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))
+ (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."
(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)
HCoop / bpt / emacs.git / blobdiff