* lisp/emacs-lisp/byte-run.el (defmacro, defun): Move from C.
(macro-declaration-function): Move var from C code. (macro-declaration-function): Define function with defalias. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't handle defun/defmacro any more. * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-signature): Provide fallback for unknown arglist. (byte-compile-arglist-warn): Change calling convention. (byte-compile-output-file-form): Move print-vars binding. (byte-compile-output-docform): Simplify accordingly. (byte-compile-file-form-defun, byte-compile-file-form-defmacro) (byte-compile-defmacro-declaration): Remove. (byte-compile-file-form-defmumble): Generalize to defalias. (byte-compile-output-as-comment): Return byte-positions. Simplify callers accordingly. (byte-compile-lambda): Use `assert'. (byte-compile-defun, byte-compile-defmacro): Remove. (byte-compile-file-form-defalias): Use byte-compile-file-form-defmumble. (byte-compile-defalias-warn): Remove. * src/eval.c (Fdefun, Fdefmacro, Vmacro_declaration_function): Move to byte-run.el. (Fautoload): Do the hash-doc more carefully. * src/data.c (Fdefalias): Purify definition, except for keymaps. (Qdefun): Move from eval.c. * src/lisp.h (Qdefun): Remove. * src/lread.c (read1): Tiny simplification. * lib-src/make-docfile.c: Improve comment style. (search_lisp_doc_at_eol): New function. (scan_lisp_file): Use it.
This commit is contained in:
Stefan Monnier
parent
934f3f582d
commit
61b108cc62
16 changed files with 487 additions and 592 deletions
|
|
@ -500,7 +500,7 @@
|
|||
(prin1-to-string form))
|
||||
nil)
|
||||
|
||||
((memq fn '(defun defmacro function condition-case))
|
||||
((memq fn '(function condition-case))
|
||||
;; These forms are compiled as constants or by breaking out
|
||||
;; all the subexpressions and compiling them separately.
|
||||
form)
|
||||
|
|
|
|||
|
|
@ -34,33 +34,98 @@
|
|||
;; handle declarations in macro definitions and this is the first file
|
||||
;; loaded by loadup.el that uses declarations in macros.
|
||||
|
||||
(defun macro-declaration-function (macro decl)
|
||||
"Process a declaration found in a macro definition.
|
||||
(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.")
|
||||
|
||||
(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)))))
|
||||
;; 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))))))
|
||||
|
||||
(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.
|
||||
|
||||
(setq macro-declaration-function 'macro-declaration-function)
|
||||
DECL is a declaration, optional, which can specify how to indent
|
||||
calls to this macro, how Edebug should handle it, and which argument
|
||||
should be treated as documentation. It looks like this:
|
||||
(declare SPECS...)
|
||||
The elements can look like this:
|
||||
(indent INDENT)
|
||||
Set NAME's `lisp-indent-function' property to INDENT.
|
||||
|
||||
(debug DEBUG)
|
||||
Set NAME's `edebug-form-spec' property to DEBUG. (This is
|
||||
equivalent to writing a `def-edebug-spec' for the macro.)
|
||||
|
||||
(doc-string ELT)
|
||||
Set NAME's `doc-string-elt' property to ELT."
|
||||
(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))))
|
||||
(if decl
|
||||
(list 'progn
|
||||
(list 'funcall 'macro-declaration-function
|
||||
(list 'quote name)
|
||||
(list 'quote decl))
|
||||
def)
|
||||
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'."
|
||||
(declare (doc-string 3))
|
||||
(if docstring (setq body (cons docstring body))
|
||||
(if (null body) (setq body '(nil))))
|
||||
(list 'defalias
|
||||
(list 'quote name)
|
||||
(list 'function
|
||||
(cons 'lambda
|
||||
(cons arglist body)))))
|
||||
|
||||
;; Redefined in byte-optimize.el.
|
||||
;; This is not documented--it's not clear that we should promote it.
|
||||
|
|
|
|||
|
|
@ -1169,12 +1169,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
|
|||
(t fn)))))))
|
||||
|
||||
(defun byte-compile-arglist-signature (arglist)
|
||||
(if (integerp arglist)
|
||||
;; New style byte-code arglist.
|
||||
(cons (logand arglist 127) ;Mandatory.
|
||||
(if (zerop (logand arglist 128)) ;No &rest.
|
||||
(lsh arglist -8))) ;Nonrest.
|
||||
;; Old style byte-code, or interpreted function.
|
||||
(cond
|
||||
;; New style byte-code arglist.
|
||||
((integerp arglist)
|
||||
(cons (logand arglist 127) ;Mandatory.
|
||||
(if (zerop (logand arglist 128)) ;No &rest.
|
||||
(lsh arglist -8)))) ;Nonrest.
|
||||
;; Old style byte-code, or interpreted function.
|
||||
((listp arglist)
|
||||
(let ((args 0)
|
||||
opts
|
||||
restp)
|
||||
|
|
@ -1190,7 +1192,9 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
|
|||
(setq opts (1+ opts))
|
||||
(setq args (1+ args)))))
|
||||
(setq arglist (cdr arglist)))
|
||||
(cons args (if restp nil (if opts (+ args opts) args))))))
|
||||
(cons args (if restp nil (if opts (+ args opts) args)))))
|
||||
;; Unknown arglist.
|
||||
(t '(0))))
|
||||
|
||||
|
||||
(defun byte-compile-arglist-signatures-congruent-p (old new)
|
||||
|
|
@ -1250,8 +1254,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
|
|||
;; and/or remember its arity if it's unknown.
|
||||
(or (and (or def (fboundp (car form))) ; might be a subr or autoload.
|
||||
(not (memq (car form) byte-compile-noruntime-functions)))
|
||||
(eq (car form) byte-compile-current-form) ; ## this doesn't work
|
||||
; with recursion.
|
||||
(eq (car form) byte-compile-current-form) ; ## This doesn't work
|
||||
; with recursion.
|
||||
;; It's a currently-undefined function.
|
||||
;; Remember number of args in call.
|
||||
(let ((cons (assq (car form) byte-compile-unresolved-functions))
|
||||
|
|
@ -1316,9 +1320,8 @@ extra args."
|
|||
|
||||
;; Warn if the function or macro is being redefined with a different
|
||||
;; number of arguments.
|
||||
(defun byte-compile-arglist-warn (form macrop)
|
||||
(let* ((name (nth 1 form))
|
||||
(old (byte-compile-fdefinition name macrop))
|
||||
(defun byte-compile-arglist-warn (name arglist macrop)
|
||||
(let* ((old (byte-compile-fdefinition name macrop))
|
||||
(initial (and macrop
|
||||
(cdr (assq name
|
||||
byte-compile-initial-macro-environment)))))
|
||||
|
|
@ -1337,12 +1340,12 @@ extra args."
|
|||
(`(closure ,_ ,args . ,_) args)
|
||||
((pred byte-code-function-p) (aref old 0))
|
||||
(t '(&rest def)))))
|
||||
(sig2 (byte-compile-arglist-signature (nth 2 form))))
|
||||
(sig2 (byte-compile-arglist-signature arglist)))
|
||||
(unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
|
||||
(byte-compile-set-symbol-position name)
|
||||
(byte-compile-warn
|
||||
"%s %s used to take %s %s, now takes %s"
|
||||
(if (eq (car form) 'defun) "function" "macro")
|
||||
(if macrop "macro" "function")
|
||||
name
|
||||
(byte-compile-arglist-signature-string sig1)
|
||||
(if (equal sig1 '(1 . 1)) "argument" "arguments")
|
||||
|
|
@ -1356,7 +1359,7 @@ extra args."
|
|||
'byte-compile-inline-expand))
|
||||
(byte-compile-warn "defsubst `%s' was used before it was defined"
|
||||
name))
|
||||
(setq sig (byte-compile-arglist-signature (nth 2 form))
|
||||
(setq sig (byte-compile-arglist-signature arglist)
|
||||
nums (sort (copy-sequence (cdr calls)) (function <))
|
||||
min (car nums)
|
||||
max (car (nreverse nums)))
|
||||
|
|
@ -2021,31 +2024,30 @@ Call from the source buffer."
|
|||
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))))
|
||||
|
||||
(defun byte-compile-output-file-form (form)
|
||||
;; writes the given form to the output buffer, being careful of docstrings
|
||||
;; Write the given form to the output buffer, being careful of docstrings
|
||||
;; in defun, defmacro, defvar, defvaralias, defconst, autoload and
|
||||
;; custom-declare-variable because make-docfile is so amazingly stupid.
|
||||
;; defalias calls are output directly by byte-compile-file-form-defmumble;
|
||||
;; it does not pay to first build the defalias in defmumble and then parse
|
||||
;; it here.
|
||||
(if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst
|
||||
autoload custom-declare-variable))
|
||||
(stringp (nth 3 form)))
|
||||
(byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
|
||||
(memq (car form)
|
||||
'(defvaralias autoload
|
||||
custom-declare-variable)))
|
||||
(let ((print-escape-newlines t)
|
||||
(print-length nil)
|
||||
(print-level nil)
|
||||
(print-quoted t)
|
||||
(print-gensym t)
|
||||
(print-circle ; handle circular data structures
|
||||
(not byte-compile-disable-print-circle)))
|
||||
(let ((print-escape-newlines t)
|
||||
(print-length nil)
|
||||
(print-level nil)
|
||||
(print-quoted t)
|
||||
(print-gensym t)
|
||||
(print-circle ; Handle circular data structures.
|
||||
(not byte-compile-disable-print-circle)))
|
||||
(if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst
|
||||
autoload custom-declare-variable))
|
||||
(stringp (nth 3 form)))
|
||||
(byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
|
||||
(memq (car form)
|
||||
'(defvaralias autoload
|
||||
custom-declare-variable)))
|
||||
(princ "\n" byte-compile--outbuffer)
|
||||
(prin1 form byte-compile--outbuffer)
|
||||
nil)))
|
||||
|
||||
(defvar print-gensym-alist) ;Used before print-circle existed.
|
||||
(defvar byte-compile--for-effect)
|
||||
|
||||
(defun byte-compile-output-docform (preface name info form specindex quoted)
|
||||
|
|
@ -2075,7 +2077,6 @@ list that represents a doc string reference.
|
|||
(setq position
|
||||
(byte-compile-output-as-comment
|
||||
(nth (nth 1 info) form) nil))
|
||||
(setq position (- (position-bytes position) (point-min) -1))
|
||||
;; If the doc string starts with * (a user variable),
|
||||
;; negate POSITION.
|
||||
(if (and (stringp (nth (nth 1 info) form))
|
||||
|
|
@ -2088,17 +2089,7 @@ list that represents a doc string reference.
|
|||
(insert preface)
|
||||
(prin1 name byte-compile--outbuffer)))
|
||||
(insert (car info))
|
||||
(let ((print-escape-newlines t)
|
||||
(print-quoted t)
|
||||
;; For compatibility with code before print-circle,
|
||||
;; use a cons cell to say that we want
|
||||
;; print-gensym-alist not to be cleared
|
||||
;; between calls to print functions.
|
||||
(print-gensym '(t))
|
||||
(print-circle ; handle circular data structures
|
||||
(not byte-compile-disable-print-circle))
|
||||
print-gensym-alist ; was used before print-circle existed.
|
||||
(print-continuous-numbering t)
|
||||
(let ((print-continuous-numbering t)
|
||||
print-number-table
|
||||
(index 0))
|
||||
(prin1 (car form) byte-compile--outbuffer)
|
||||
|
|
@ -2121,8 +2112,6 @@ list that represents a doc string reference.
|
|||
(byte-compile-output-as-comment
|
||||
(cons (car form) (nth 1 form))
|
||||
t)))
|
||||
(setq position (- (position-bytes position)
|
||||
(point-min) -1))
|
||||
(princ (format "(#$ . %d) nil" position)
|
||||
byte-compile--outbuffer)
|
||||
(setq form (cdr form))
|
||||
|
|
@ -2317,143 +2306,132 @@ list that represents a doc string reference.
|
|||
(nth 1 (nth 1 form))
|
||||
(byte-compile-keep-pending form)))
|
||||
|
||||
(put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun)
|
||||
(defun byte-compile-file-form-defun (form)
|
||||
(byte-compile-file-form-defmumble form nil))
|
||||
(defun byte-compile-file-form-defmumble (name macro arglist body rest)
|
||||
"Process a `defalias' for NAME.
|
||||
If MACRO is non-nil, the definition is known to be a macro.
|
||||
ARGLIST is the list of arguments, if it was recognized or t otherwise.
|
||||
BODY of the definition, or t if not recognized.
|
||||
Return non-nil if everything went as planned, or nil to imply that it decided
|
||||
not to take responsibility for the actual compilation of the code."
|
||||
(let* ((this-kind (if macro 'byte-compile-macro-environment
|
||||
'byte-compile-function-environment))
|
||||
(that-kind (if macro 'byte-compile-function-environment
|
||||
'byte-compile-macro-environment))
|
||||
(this-one (assq name (symbol-value this-kind)))
|
||||
(that-one (assq name (symbol-value that-kind)))
|
||||
(byte-compile-current-form name)) ; For warnings.
|
||||
|
||||
(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro)
|
||||
(defun byte-compile-file-form-defmacro (form)
|
||||
(byte-compile-file-form-defmumble form t))
|
||||
|
||||
(defun byte-compile-defmacro-declaration (form)
|
||||
"Generate code for declarations in macro definitions.
|
||||
Remove declarations from the body of the macro definition
|
||||
by side-effects."
|
||||
(let ((tail (nthcdr 2 form))
|
||||
(res '()))
|
||||
(when (stringp (car (cdr tail)))
|
||||
(setq tail (cdr tail)))
|
||||
(while (and (consp (car (cdr tail)))
|
||||
(eq (car (car (cdr tail))) 'declare))
|
||||
(let ((declaration (car (cdr tail))))
|
||||
(setcdr tail (cdr (cdr tail)))
|
||||
(push `(if macro-declaration-function
|
||||
(funcall macro-declaration-function
|
||||
',(car (cdr form)) ',declaration))
|
||||
res)))
|
||||
res))
|
||||
|
||||
(defun byte-compile-file-form-defmumble (form macrop)
|
||||
(let* ((name (car (cdr form)))
|
||||
(this-kind (if macrop 'byte-compile-macro-environment
|
||||
'byte-compile-function-environment))
|
||||
(that-kind (if macrop 'byte-compile-function-environment
|
||||
'byte-compile-macro-environment))
|
||||
(this-one (assq name (symbol-value this-kind)))
|
||||
(that-one (assq name (symbol-value that-kind)))
|
||||
(byte-compile-free-references nil)
|
||||
(byte-compile-free-assignments nil))
|
||||
(byte-compile-set-symbol-position name)
|
||||
;; When a function or macro is defined, add it to the call tree so that
|
||||
;; we can tell when functions are not used.
|
||||
(if byte-compile-generate-call-tree
|
||||
(or (assq name byte-compile-call-tree)
|
||||
(setq byte-compile-call-tree
|
||||
(cons (list name nil nil) byte-compile-call-tree))))
|
||||
(or (assq name byte-compile-call-tree)
|
||||
(setq byte-compile-call-tree
|
||||
(cons (list name nil nil) byte-compile-call-tree))))
|
||||
|
||||
(setq byte-compile-current-form name) ; for warnings
|
||||
(if (byte-compile-warning-enabled-p 'redefine)
|
||||
(byte-compile-arglist-warn form macrop))
|
||||
(byte-compile-arglist-warn name arglist macro))
|
||||
|
||||
(if byte-compile-verbose
|
||||
(message "Compiling %s... (%s)"
|
||||
(or byte-compile-current-file "") (nth 1 form)))
|
||||
(cond (that-one
|
||||
(if (and (byte-compile-warning-enabled-p 'redefine)
|
||||
;; don't warn when compiling the stubs in byte-run...
|
||||
(not (assq (nth 1 form)
|
||||
byte-compile-initial-macro-environment)))
|
||||
(byte-compile-warn
|
||||
"`%s' defined multiple times, as both function and macro"
|
||||
(nth 1 form)))
|
||||
(setcdr that-one nil))
|
||||
(this-one
|
||||
(when (and (byte-compile-warning-enabled-p 'redefine)
|
||||
;; hack: don't warn when compiling the magic internal
|
||||
;; byte-compiler macros in byte-run.el...
|
||||
(not (assq (nth 1 form)
|
||||
byte-compile-initial-macro-environment)))
|
||||
(byte-compile-warn "%s `%s' defined multiple times in this file"
|
||||
(if macrop "macro" "function")
|
||||
(nth 1 form))))
|
||||
((and (fboundp name)
|
||||
(eq (car-safe (symbol-function name))
|
||||
(if macrop 'lambda 'macro)))
|
||||
(when (byte-compile-warning-enabled-p 'redefine)
|
||||
(byte-compile-warn "%s `%s' being redefined as a %s"
|
||||
(if macrop "function" "macro")
|
||||
(nth 1 form)
|
||||
(if macrop "macro" "function")))
|
||||
;; shadow existing definition
|
||||
(set this-kind
|
||||
(cons (cons name nil)
|
||||
(symbol-value this-kind))))
|
||||
)
|
||||
(let ((body (nthcdr 3 form)))
|
||||
(when (and (stringp (car body))
|
||||
(symbolp (car-safe (cdr-safe body)))
|
||||
(car-safe (cdr-safe body))
|
||||
(stringp (car-safe (cdr-safe (cdr-safe body)))))
|
||||
(byte-compile-set-symbol-position (nth 1 form))
|
||||
(byte-compile-warn "probable `\"' without `\\' in doc string of %s"
|
||||
(nth 1 form))))
|
||||
|
||||
;; Generate code for declarations in macro definitions.
|
||||
;; Remove declarations from the body of the macro definition.
|
||||
(when macrop
|
||||
(dolist (decl (byte-compile-defmacro-declaration form))
|
||||
(prin1 decl byte-compile--outbuffer)))
|
||||
|
||||
(let* ((code (byte-compile-lambda (nthcdr 2 form) t)))
|
||||
(if this-one
|
||||
;; A definition in b-c-initial-m-e should always take precedence
|
||||
;; during compilation, so don't let it be redefined. (Bug#8647)
|
||||
(or (and macrop
|
||||
(assq name byte-compile-initial-macro-environment))
|
||||
(setcdr this-one code))
|
||||
(set this-kind
|
||||
(cons (cons name code)
|
||||
(symbol-value this-kind))))
|
||||
(byte-compile-flush-pending)
|
||||
(if (not (stringp (nth 3 form)))
|
||||
;; No doc string. Provide -1 as the "doc string index"
|
||||
;; so that no element will be treated as a doc string.
|
||||
(byte-compile-output-docform
|
||||
"\n(defalias '"
|
||||
name
|
||||
(if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))
|
||||
(append code nil) ; Turn byte-code-function-p into list.
|
||||
(and (atom code) byte-compile-dynamic
|
||||
1)
|
||||
(message "Compiling %s... (%s)"
|
||||
(or byte-compile-current-file "") name))
|
||||
(cond ((not (or macro (listp body)))
|
||||
;; We do not know positively if the definition is a macro
|
||||
;; or a function, so we shouldn't emit warnings.
|
||||
;; This also silences "multiple definition" warnings for defmethods.
|
||||
nil)
|
||||
;; Output the form by hand, that's much simpler than having
|
||||
;; b-c-output-file-form analyze the defalias.
|
||||
(byte-compile-output-docform
|
||||
"\n(defalias '"
|
||||
name
|
||||
(if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))
|
||||
(append code nil) ; Turn byte-code-function-p into list.
|
||||
(and (atom code) byte-compile-dynamic
|
||||
1)
|
||||
nil))
|
||||
(princ ")" byte-compile--outbuffer)
|
||||
nil)))
|
||||
(that-one
|
||||
(if (and (byte-compile-warning-enabled-p 'redefine)
|
||||
;; Don't warn when compiling the stubs in byte-run...
|
||||
(not (assq name byte-compile-initial-macro-environment)))
|
||||
(byte-compile-warn
|
||||
"`%s' defined multiple times, as both function and macro"
|
||||
name))
|
||||
(setcdr that-one nil))
|
||||
(this-one
|
||||
(when (and (byte-compile-warning-enabled-p 'redefine)
|
||||
;; Hack: Don't warn when compiling the magic internal
|
||||
;; byte-compiler macros in byte-run.el...
|
||||
(not (assq name byte-compile-initial-macro-environment)))
|
||||
(byte-compile-warn "%s `%s' defined multiple times in this file"
|
||||
(if macro "macro" "function")
|
||||
name)))
|
||||
((and (fboundp name)
|
||||
(eq (car-safe (symbol-function name))
|
||||
(if macro 'lambda 'macro)))
|
||||
(when (byte-compile-warning-enabled-p 'redefine)
|
||||
(byte-compile-warn "%s `%s' being redefined as a %s"
|
||||
(if macro "function" "macro")
|
||||
name
|
||||
(if macro "macro" "function")))
|
||||
;; Shadow existing definition.
|
||||
(set this-kind
|
||||
(cons (cons name nil)
|
||||
(symbol-value this-kind))))
|
||||
)
|
||||
|
||||
(when (and (listp body)
|
||||
(stringp (car body))
|
||||
(symbolp (car-safe (cdr-safe body)))
|
||||
(car-safe (cdr-safe body))
|
||||
(stringp (car-safe (cdr-safe (cdr-safe body)))))
|
||||
;; FIXME: We've done that already just above, so this looks wrong!
|
||||
;;(byte-compile-set-symbol-position name)
|
||||
(byte-compile-warn "probable `\"' without `\\' in doc string of %s"
|
||||
name))
|
||||
|
||||
(if (not (listp body))
|
||||
;; The precise definition requires evaluation to find out, so it
|
||||
;; will only be known at runtime.
|
||||
;; For a macro, that means we can't use that macro in the same file.
|
||||
(progn
|
||||
(unless macro
|
||||
(push (cons name (if (listp arglist) `(declared ,arglist) t))
|
||||
byte-compile-function-environment))
|
||||
;; Tell the caller that we didn't compile it yet.
|
||||
nil)
|
||||
|
||||
(let* ((code (byte-compile-lambda (cons arglist body) t)))
|
||||
(if this-one
|
||||
;; A definition in b-c-initial-m-e should always take precedence
|
||||
;; during compilation, so don't let it be redefined. (Bug#8647)
|
||||
(or (and macro
|
||||
(assq name byte-compile-initial-macro-environment))
|
||||
(setcdr this-one code))
|
||||
(set this-kind
|
||||
(cons (cons name code)
|
||||
(symbol-value this-kind))))
|
||||
|
||||
(if rest
|
||||
;; There are additional args to `defalias' (like maybe a docstring)
|
||||
;; that the code below can't handle: punt!
|
||||
nil
|
||||
;; Otherwise, we have a bona-fide defun/defmacro definition, and use
|
||||
;; special code to allow dynamic docstrings and byte-code.
|
||||
(byte-compile-flush-pending)
|
||||
(let ((index
|
||||
;; If there's no doc string, provide -1 as the "doc string
|
||||
;; index" so that no element will be treated as a doc string.
|
||||
(if (not (stringp (car body))) -1 4)))
|
||||
;; Output the form by hand, that's much simpler than having
|
||||
;; b-c-output-file-form analyze the defalias.
|
||||
(byte-compile-output-docform
|
||||
"\n(defalias '"
|
||||
name
|
||||
(if macro `(" '(macro . #[" ,index "])") `(" #[" ,index "]"))
|
||||
(append code nil) ; Turn byte-code-function-p into list.
|
||||
(and (atom code) byte-compile-dynamic
|
||||
1)
|
||||
nil))
|
||||
(princ ")" byte-compile--outbuffer)
|
||||
t)))))
|
||||
|
||||
;; Print Lisp object EXP in the output file, inside a comment,
|
||||
;; and return the file position it will have.
|
||||
;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
|
||||
(defun byte-compile-output-as-comment (exp quoted)
|
||||
(let ((position (point)))
|
||||
(with-current-buffer byte-compile--outbuffer
|
||||
"Print Lisp object EXP in the output file, inside a comment,
|
||||
and return the file (byte) position it will have.
|
||||
If QUOTED is non-nil, print with quoting; otherwise, print without quoting."
|
||||
(with-current-buffer byte-compile--outbuffer
|
||||
(let ((position (point)))
|
||||
|
||||
;; Insert EXP, and make it a comment with #@LENGTH.
|
||||
(insert " ")
|
||||
|
|
@ -2478,13 +2456,12 @@ by side-effects."
|
|||
(position-bytes position))))
|
||||
|
||||
;; Save the file position of the object.
|
||||
;; Note we should add 1 to skip the space
|
||||
;; that we inserted before the actual doc string,
|
||||
;; and subtract 1 to convert from an 1-origin Emacs position
|
||||
;; to a file position; they cancel.
|
||||
(setq position (point))
|
||||
(goto-char (point-max)))
|
||||
position))
|
||||
;; Note we add 1 to skip the space that we inserted before the actual doc
|
||||
;; string, and subtract point-min to convert from an 1-origin Emacs
|
||||
;; position to a file position.
|
||||
(prog1
|
||||
(- (position-bytes (point)) (point-min) -1)
|
||||
(goto-char (point-max))))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -2581,14 +2558,15 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
(lsh nonrest 8)
|
||||
(lsh rest 7)))))
|
||||
|
||||
;; Byte-compile a lambda-expression and return a valid function.
|
||||
;; The value is usually a compiled function but may be the original
|
||||
;; lambda-expression.
|
||||
;; When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
|
||||
;; of the list FUN and `byte-compile-set-symbol-position' is not called.
|
||||
;; Use this feature to avoid calling `byte-compile-set-symbol-position'
|
||||
;; for symbols generated by the byte compiler itself.
|
||||
|
||||
(defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
|
||||
"Byte-compile a lambda-expression and return a valid function.
|
||||
The value is usually a compiled function but may be the original
|
||||
lambda-expression.
|
||||
When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
|
||||
of the list FUN and `byte-compile-set-symbol-position' is not called.
|
||||
Use this feature to avoid calling `byte-compile-set-symbol-position'
|
||||
for symbols generated by the byte compiler itself."
|
||||
(if add-lambda
|
||||
(setq fun (cons 'lambda fun))
|
||||
(unless (eq 'lambda (car-safe fun))
|
||||
|
|
@ -2649,24 +2627,23 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
(byte-compile-make-lambda-lexenv fun))
|
||||
reserved-csts)))
|
||||
;; Build the actual byte-coded function.
|
||||
(if (eq 'byte-code (car-safe compiled))
|
||||
(apply 'make-byte-code
|
||||
(if lexical-binding
|
||||
(byte-compile-make-args-desc arglist)
|
||||
arglist)
|
||||
(append
|
||||
;; byte-string, constants-vector, stack depth
|
||||
(cdr compiled)
|
||||
;; optionally, the doc string.
|
||||
(cond (lexical-binding
|
||||
(require 'help-fns)
|
||||
(list (help-add-fundoc-usage doc arglist)))
|
||||
((or doc int)
|
||||
(list doc)))
|
||||
;; optionally, the interactive spec.
|
||||
(if int
|
||||
(list (nth 1 int)))))
|
||||
(error "byte-compile-top-level did not return byte-code")))))
|
||||
(assert (eq 'byte-code (car-safe compiled)))
|
||||
(apply #'make-byte-code
|
||||
(if lexical-binding
|
||||
(byte-compile-make-args-desc arglist)
|
||||
arglist)
|
||||
(append
|
||||
;; byte-string, constants-vector, stack depth
|
||||
(cdr compiled)
|
||||
;; optionally, the doc string.
|
||||
(cond (lexical-binding
|
||||
(require 'help-fns)
|
||||
(list (help-add-fundoc-usage doc arglist)))
|
||||
((or doc int)
|
||||
(list doc)))
|
||||
;; optionally, the interactive spec.
|
||||
(if int
|
||||
(list (nth 1 int))))))))
|
||||
|
||||
(defvar byte-compile-reserved-constants 0)
|
||||
|
||||
|
|
@ -3066,9 +3043,9 @@ That command is designed for interactive use only" fn))
|
|||
(byte-compile-check-variable var 'assign)
|
||||
(let ((lex-binding (assq var byte-compile--lexical-environment)))
|
||||
(if lex-binding
|
||||
;; VAR is lexically bound
|
||||
;; VAR is lexically bound.
|
||||
(byte-compile-stack-set (cdr lex-binding))
|
||||
;; VAR is dynamically bound
|
||||
;; VAR is dynamically bound.
|
||||
(unless (or (not (byte-compile-warning-enabled-p 'free-vars))
|
||||
(boundp var)
|
||||
(memq var byte-compile-bound-variables)
|
||||
|
|
@ -3353,6 +3330,7 @@ discarding."
|
|||
(body (nthcdr 3 form))
|
||||
(fun
|
||||
(byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
|
||||
(assert (> (length env) 0)) ;Otherwise, we don't need a closure.
|
||||
(assert (byte-code-function-p fun))
|
||||
(byte-compile-form `(make-byte-code
|
||||
',(aref fun 0) ',(aref fun 1)
|
||||
|
|
@ -4074,36 +4052,11 @@ binding slots have been popped."
|
|||
|
||||
;;; top-level forms elsewhere
|
||||
|
||||
(byte-defop-compiler-1 defun)
|
||||
(byte-defop-compiler-1 defmacro)
|
||||
(byte-defop-compiler-1 defvar)
|
||||
(byte-defop-compiler-1 defconst byte-compile-defvar)
|
||||
(byte-defop-compiler-1 autoload)
|
||||
(byte-defop-compiler-1 lambda byte-compile-lambda-form)
|
||||
|
||||
(defun byte-compile-defun (form)
|
||||
;; This is not used for file-level defuns with doc strings.
|
||||
(if (symbolp (car form))
|
||||
(byte-compile-set-symbol-position (car form))
|
||||
(byte-compile-set-symbol-position 'defun)
|
||||
(error "defun name must be a symbol, not %s" (car form)))
|
||||
(byte-compile-push-constant 'defalias)
|
||||
(byte-compile-push-constant (nth 1 form))
|
||||
(byte-compile-push-constant (byte-compile-lambda (cdr (cdr form)) t))
|
||||
(byte-compile-out 'byte-call 2))
|
||||
|
||||
(defun byte-compile-defmacro (form)
|
||||
;; This is not used for file-level defmacros with doc strings.
|
||||
(byte-compile-body-do-effect
|
||||
(let ((decls (byte-compile-defmacro-declaration form))
|
||||
(code (byte-compile-lambda (cdr (cdr form)) t)))
|
||||
`((defalias ',(nth 1 form)
|
||||
,(if (eq (car-safe code) 'make-byte-code)
|
||||
`(cons 'macro ,code)
|
||||
`'(macro . ,(eval code))))
|
||||
,@decls
|
||||
',(nth 1 form)))))
|
||||
|
||||
;; If foo.el declares `toto' as obsolete, it is likely that foo.el will
|
||||
;; actually use `toto' in order for this obsolete variable to still work
|
||||
;; correctly, so paradoxically, while byte-compiling foo.el, the presence
|
||||
|
|
@ -4179,38 +4132,53 @@ binding slots have been popped."
|
|||
(put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias)
|
||||
;; Used for eieio--defalias as well.
|
||||
(defun byte-compile-file-form-defalias (form)
|
||||
(if (and (consp (cdr form)) (consp (nth 1 form))
|
||||
(eq (car (nth 1 form)) 'quote)
|
||||
(consp (cdr (nth 1 form)))
|
||||
(symbolp (nth 1 (nth 1 form))))
|
||||
(let ((constant
|
||||
(and (consp (nthcdr 2 form))
|
||||
(consp (nth 2 form))
|
||||
(eq (car (nth 2 form)) 'quote)
|
||||
(consp (cdr (nth 2 form)))
|
||||
(symbolp (nth 1 (nth 2 form))))))
|
||||
(byte-compile-defalias-warn (nth 1 (nth 1 form)))
|
||||
(push (cons (nth 1 (nth 1 form))
|
||||
(if constant (nth 1 (nth 2 form)) t))
|
||||
byte-compile-function-environment)))
|
||||
;; We used to just do: (byte-compile-normal-call form)
|
||||
;; But it turns out that this fails to optimize the code.
|
||||
;; So instead we now do the same as what other byte-hunk-handlers do,
|
||||
;; which is to call back byte-compile-file-form and then return nil.
|
||||
;; Except that we can't just call byte-compile-file-form since it would
|
||||
;; call us right back.
|
||||
(byte-compile-keep-pending form)
|
||||
;; Return nil so the form is not output twice.
|
||||
nil)
|
||||
;; For the compilation itself, we could largely get rid of this hunk-handler,
|
||||
;; if it weren't for the fact that we need to figure out when a defalias
|
||||
;; defines a macro, so as to add it to byte-compile-macro-environment.
|
||||
;;
|
||||
;; FIXME: we also use this hunk-handler to implement the function's dynamic
|
||||
;; docstring feature. We could actually implement it more elegantly in
|
||||
;; byte-compile-lambda so it applies to all lambdas, but the problem is that
|
||||
;; the resulting .elc format will not be recognized by make-docfile, so
|
||||
;; either we stop using DOC for the docstrings of preloaded elc files (at the
|
||||
;; cost of around 24KB on 32bit hosts, double on 64bit hosts) or we need to
|
||||
;; build DOC in a more clever way (e.g. handle anonymous elements).
|
||||
(let ((byte-compile-free-references nil)
|
||||
(byte-compile-free-assignments nil))
|
||||
(pcase form
|
||||
;; Decompose `form' into:
|
||||
;; - `name' is the name of the defined function.
|
||||
;; - `arg' is the expression to which it is defined.
|
||||
;; - `rest' is the rest of the arguments.
|
||||
(`(,_ ',name ,arg . ,rest)
|
||||
(pcase-let*
|
||||
;; `macro' is non-nil if it defines a macro.
|
||||
;; `fun' is the function part of `arg' (defaults to `arg').
|
||||
(((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let macro t))
|
||||
(and (let fun arg) (let macro nil)))
|
||||
arg)
|
||||
;; `lam' is the lambda expression in `fun' (or nil if not
|
||||
;; recognized).
|
||||
((or `(,(or `quote `function) ,lam) (let lam nil))
|
||||
fun)
|
||||
;; `arglist' is the list of arguments (or t if not recognized).
|
||||
;; `body' is the body of `lam' (or t if not recognized).
|
||||
((or `(lambda ,arglist . ,body)
|
||||
;; `(closure ,_ ,arglist . ,body)
|
||||
(and `(internal-make-closure ,arglist . ,_) (let body t))
|
||||
(and (let arglist t) (let body t)))
|
||||
lam))
|
||||
(unless (byte-compile-file-form-defmumble
|
||||
name macro arglist body rest)
|
||||
(byte-compile-keep-pending form))))
|
||||
|
||||
;; Turn off warnings about prior calls to the function being defalias'd.
|
||||
;; This could be smarter and compare those calls with
|
||||
;; the function it is being aliased to.
|
||||
(defun byte-compile-defalias-warn (new)
|
||||
(let ((calls (assq new byte-compile-unresolved-functions)))
|
||||
(if calls
|
||||
(setq byte-compile-unresolved-functions
|
||||
(delq calls byte-compile-unresolved-functions)))))
|
||||
;; We used to just do: (byte-compile-normal-call form)
|
||||
;; But it turns out that this fails to optimize the code.
|
||||
;; So instead we now do the same as what other byte-hunk-handlers do,
|
||||
;; which is to call back byte-compile-file-form and then return nil.
|
||||
;; Except that we can't just call byte-compile-file-form since it would
|
||||
;; call us right back.
|
||||
(t (byte-compile-keep-pending form)))))
|
||||
|
||||
(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
|
||||
(defun byte-compile-no-warnings (form)
|
||||
|
|
|
|||
|
|
@ -73,8 +73,6 @@
|
|||
;; since afterwards they can because obnoxious (warnings about an "unused
|
||||
;; variable" should not be emitted when the variable use has simply been
|
||||
;; optimized away).
|
||||
;; - turn defun and defmacro into macros (and remove special handling of
|
||||
;; `declare' afterwards).
|
||||
;; - let macros specify that some let-bindings come from the same source,
|
||||
;; so the unused warning takes all uses into account.
|
||||
;; - let interactive specs return a function to build the args (to stash into
|
||||
|
|
@ -410,20 +408,6 @@ places where they originally did not directly appear."
|
|||
. ,(mapcar (lambda (form) (cconv-convert form env extend))
|
||||
forms)))
|
||||
|
||||
;defun, defmacro
|
||||
(`(,(and sym (or `defun `defmacro))
|
||||
,func ,args . ,body)
|
||||
(assert (equal body (caar cconv-freevars-alist)))
|
||||
(assert (null (cdar cconv-freevars-alist)))
|
||||
|
||||
(let ((new (cconv--convert-function args body env form)))
|
||||
(pcase new
|
||||
(`(function (lambda ,newargs . ,new-body))
|
||||
(assert (equal args newargs))
|
||||
`(,sym ,func ,args . ,new-body))
|
||||
(t (byte-compile-report-error
|
||||
(format "Internal error in cconv of (%s %s ...)" sym func))))))
|
||||
|
||||
;condition-case
|
||||
(`(condition-case ,var ,protected-form . ,handlers)
|
||||
(let ((newform (cconv--convert-function
|
||||
|
|
@ -618,15 +602,6 @@ and updates the data stored in ENV."
|
|||
(dolist (vardata newvars)
|
||||
(cconv--analyse-use vardata form "variable"))))
|
||||
|
||||
; defun special form
|
||||
(`(,(or `defun `defmacro) ,func ,vrs . ,body-forms)
|
||||
(when env
|
||||
(byte-compile-log-warning
|
||||
(format "Function %S will ignore its context %S"
|
||||
func (mapcar #'car env))
|
||||
t :warning))
|
||||
(cconv--analyse-function vrs body-forms nil form))
|
||||
|
||||
(`(function (lambda ,vrs . ,body-forms))
|
||||
(cconv--analyse-function vrs body-forms env form))
|
||||
|
||||
|
|
|
|||
|
|
@ -357,6 +357,8 @@ Returns the forms."
|
|||
(set (make-local-variable 'elint-buffer-env)
|
||||
(elint-init-env elint-buffer-forms))
|
||||
(if elint-preloaded-env
|
||||
;; FIXME: This doesn't do anything! Should we setq the result to
|
||||
;; elint-buffer-env?
|
||||
(elint-env-add-env elint-preloaded-env elint-buffer-env))
|
||||
(set (make-local-variable 'elint-last-env-time) (buffer-modified-tick))
|
||||
elint-buffer-forms))
|
||||
|
|
|
|||
|
|
@ -135,11 +135,9 @@ It has `lisp-mode-abbrev-table' as its parent."
|
|||
|
||||
;; This was originally in autoload.el and is still used there.
|
||||
(put 'autoload 'doc-string-elt 3)
|
||||
(put 'defun 'doc-string-elt 3)
|
||||
(put 'defmethod 'doc-string-elt 3)
|
||||
(put 'defvar 'doc-string-elt 3)
|
||||
(put 'defconst 'doc-string-elt 3)
|
||||
(put 'defmacro 'doc-string-elt 3)
|
||||
(put 'defalias 'doc-string-elt 3)
|
||||
(put 'defvaralias 'doc-string-elt 3)
|
||||
(put 'define-category 'doc-string-elt 2)
|
||||
|
|
|
|||
|
|
@ -65,7 +65,7 @@ result will be eq to LIST).
|
|||
(,unshared nil)
|
||||
(,tail ,shared)
|
||||
,var ,new-el)
|
||||
(while ,tail
|
||||
(while (consp ,tail)
|
||||
(setq ,var (car ,tail)
|
||||
,new-el (progn ,@body))
|
||||
(unless (eq ,var ,new-el)
|
||||
|
|
@ -128,20 +128,6 @@ Assumes the caller has bound `macroexpand-all-environment'."
|
|||
(cddr form))
|
||||
(cdr form))
|
||||
form))
|
||||
(`(defmacro ,name . ,args-and-body)
|
||||
(push (cons name (cons 'lambda args-and-body))
|
||||
macroexpand-all-environment)
|
||||
(let ((n 3))
|
||||
;; Don't macroexpand `declare' since it should really be "expanded"
|
||||
;; away when `defmacro' is expanded, but currently defmacro is not
|
||||
;; itself a macro. So both `defmacro' and `declare' need to be
|
||||
;; handled directly in bytecomp.el.
|
||||
;; FIXME: Maybe a simpler solution is to (defalias 'declare 'quote).
|
||||
(while (or (stringp (nth n form))
|
||||
(eq (car-safe (nth n form)) 'declare))
|
||||
(setq n (1+ n)))
|
||||
(macroexpand-all-forms form n)))
|
||||
(`(defun . ,_) (macroexpand-all-forms form 3))
|
||||
(`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2))
|
||||
(`(function ,(and f `(lambda . ,_)))
|
||||
(maybe-cons 'function
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue