procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'savannah/master' into native-comp

Browse source
This commit is contained in:
Andrea Corallo 2021-01-24 21:05:33 +01:00
commit b8d3ae78c5
194 changed files with 5165 additions and 2633 deletions
Download patch file Download diff file Expand all files Collapse all files

1367
lisp/emacs-lisp/byte-opt.el
View file

File diff suppressed because it is too large Load diff

16
lisp/emacs-lisp/byte-run.el
View file

@ -238,8 +238,11 @@ The return value is undefined.
#'(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))))
(macroexp--warn-and-return
(format-message
"Unknown macro property %S in %S"
(car x) name)
nil))))
decls)))
;; Refresh font-lock if this is a new macro, or it is an
;; existing macro whose 'no-font-lock-keyword declaration
@ -307,9 +310,12 @@ The return value is undefined.
(cdr body)
body)))
nil)
(t (message "Warning: Unknown defun property `%S' in %S"
(car x) name)))))
decls))
(t
(macroexp--warn-and-return
(format-message "Unknown defun property `%S' in %S"
(car x) name)
nil)))))
decls))
(def (list 'defalias
(list 'quote name)
(list 'function

3
lisp/emacs-lisp/bytecomp.el
View file

@ -2577,7 +2577,8 @@ list that represents a doc string reference.
(when (memq sym byte-compile-lexical-variables)
(setq byte-compile-lexical-variables
(delq sym byte-compile-lexical-variables))
(byte-compile-warn "Variable `%S' declared after its first use" sym))
(when (byte-compile-warning-enabled-p 'lexical sym)
(byte-compile-warn "Variable `%S' declared after its first use" sym)))
(push sym byte-compile-bound-variables)
(push sym byte-compile--seen-defvars))

7
lisp/emacs-lisp/checkdoc.el
View file

@ -241,7 +241,12 @@ system. Possible values are:
defun - Spell-check when style checking a single defun.
buffer - Spell-check when style checking the whole buffer.
interactive - Spell-check during any interactive check.
t - Always spell-check."
t - Always spell-check.
There is a list of Lisp-specific words which checkdoc will
install into Ispell on the fly, but only if Ispell is not already
running. Use `ispell-kill-ispell' to make checkdoc restart it
with these words enabled."
:type '(choice (const nil)
(const defun)
(const buffer)

4
lisp/emacs-lisp/ert.el
View file

@ -487,7 +487,7 @@ Errors during evaluation are caught and handled like nil."
Returns nil if they are."
(if (not (eq (type-of a) (type-of b)))
`(different-types ,a ,b)
(pcase-exhaustive a
(pcase a
((pred consp)
(let ((a-length (proper-list-p a))
(b-length (proper-list-p b)))
@ -538,7 +538,7 @@ Returns nil if they are."
for xi = (ert--explain-equal-rec ai bi)
do (when xi (cl-return `(array-elt ,i ,xi)))
finally (cl-assert (equal a b) t))))
((pred atom)
(_
(if (not (equal a b))
(if (and (symbolp a) (symbolp b) (string= a b))
`(different-symbols-with-the-same-name ,a ,b)

14
lisp/emacs-lisp/macroexp.el
View file

@ -127,7 +127,7 @@ and also to avoid outputting the warning during normal execution."
(cond
((null msg) form)
((macroexp--compiling-p)
(if (gethash form macroexp--warned)
(if (and (consp form) (gethash form macroexp--warned))
;; Already wrapped this exp with a warning: avoid inf-looping
;; where we keep adding the same warning onto `form' because
;; macroexpand-all gets right back to macroexpanding `form'.
@ -138,9 +138,10 @@ and also to avoid outputting the warning during normal execution."
,form)))
(t
(unless compile-only
(message "%s%s" (if (stringp load-file-name)
(concat (file-relative-name load-file-name) ": ")
"")
(message "%sWarning: %s"
(if (stringp load-file-name)
(concat (file-relative-name load-file-name) ": ")
"")
msg))
form))))
@ -180,8 +181,9 @@ and also to avoid outputting the warning during normal execution."
(defun macroexp-macroexpand (form env)
"Like `macroexpand' but checking obsolescence."
(let ((new-form
(macroexpand form env)))
(let* ((macroexpand-all-environment env)
(new-form
(macroexpand form env)))
(if (and (not (eq form new-form)) ;It was a macro call.
(car-safe form)
(symbolp (car form))

2
lisp/emacs-lisp/package.el
View file

@ -3288,9 +3288,9 @@ To unhide a package, type
`\\[customize-variable] RET package-hidden-regexps'.
Type \\[package-menu-toggle-hiding] to toggle package hiding."
(declare (interactive-only "change `package-hidden-regexps' instead."))
(interactive)
(package--ensure-package-menu-mode)
(declare (interactive-only "change `package-hidden-regexps' instead."))
(let* ((name (when (derived-mode-p 'package-menu-mode)
(concat "\\`" (regexp-quote (symbol-name (package-desc-name
(tabulated-list-get-id))))

46
lisp/emacs-lisp/pcase.el
View file

@ -39,10 +39,10 @@
;; - along these lines, provide patterns to match CL structs.
;; - provide something like (setq VAR) so a var can be set rather than
;; let-bound.
;; - provide a way to fallthrough to subsequent cases (not sure what I meant by
;; this :-()
;; - provide a way to fallthrough to subsequent cases
;; (e.g. Like Racket's (=> ID).
;; - try and be more clever to reduce the size of the decision tree, and
;; to reduce the number of leaves that need to be turned into function:
;; to reduce the number of leaves that need to be turned into functions:
;; - first, do the tests shared by all remaining branches (it will have
;; to be performed anyway, so better do it first so it's shared).
;; - then choose the test that discriminates more (?).
@ -97,11 +97,15 @@
(declare-function get-edebug-spec "edebug" (symbol))
(declare-function edebug-match "edebug" (cursor specs))
(defun pcase--get-macroexpander (s)
"Return the macroexpander for pcase pattern head S, or nil"
(get s 'pcase-macroexpander))
(defun pcase--edebug-match-macro (cursor)
(let (specs)
(mapatoms
(lambda (s)
(let ((m (get s 'pcase-macroexpander)))
(let ((m (pcase--get-macroexpander s)))
(when (and m (get-edebug-spec m))
(push (cons (symbol-name s) (get-edebug-spec m))
specs)))))
@ -128,6 +132,7 @@ PATTERN matches. PATTERN can take one of the forms:
If a SYMBOL is used twice in the same pattern
the second occurrence becomes an `eq'uality test.
(pred FUN) matches if FUN called on EXPVAL returns non-nil.
(pred (not FUN)) matches if FUN called on EXPVAL returns nil.
(app FUN PAT) matches if FUN called on EXPVAL matches PAT.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
(let PAT EXPR) matches if EXPR matches PAT.
@ -193,7 +198,7 @@ Emacs Lisp manual for more information and examples."
(let (more)
;; Collect all the extensions.
(mapatoms (lambda (symbol)
(let ((me (get symbol 'pcase-macroexpander)))
(let ((me (pcase--get-macroexpander symbol)))
(when me
(push (cons symbol me)
more)))))
@ -424,7 +429,7 @@ of the elements of LIST is performed as if by `pcase-let'.
((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
(t
(let* ((expander (get head 'pcase-macroexpander))
(let* ((expander (pcase--get-macroexpander head))
(npat (if expander (apply expander (cdr pat)))))
(if (null npat)
(error (if expander
@ -658,6 +663,14 @@ MATCH is the pattern that needs to be matched, of the form:
'(:pcase--succeed . nil))))
(defun pcase--split-pred (vars upat pat)
"Indicate the overlap or mutual-exclusion between UPAT and PAT.
More specifically retuns a pair (A . B) where A indicates whether PAT
can match when UPAT has matched, and B does the same for the case
where UPAT failed to match.
A and B can be one of:
- nil if we don't know
- `:pcase--fail' if UPAT match's result implies that PAT can't match
- `:pcase--succeed' if UPAT match's result implies that PAT matches"
(let (test)
(cond
((and (equal upat pat)
@ -670,6 +683,19 @@ MATCH is the pattern that needs to be matched, of the form:
;; and catch at least the easy cases such as (bug#14773).
(not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
'(:pcase--succeed . :pcase--fail))
;; In case UPAT is of the form (pred (not PRED))
((and (eq 'pred (car upat)) (eq 'not (car-safe (cadr upat))))
(let* ((test (cadr (cadr upat)))
(res (pcase--split-pred vars `(pred ,test) pat)))
(cons (cdr res) (car res))))
;; In case PAT is of the form (pred (not PRED))
((and (eq 'pred (car-safe pat)) (eq 'not (car-safe (cadr pat))))
(let* ((test (cadr (cadr pat)))
(res (pcase--split-pred vars upat `(pred ,test)))
(reverse (lambda (x) (cond ((eq x :pcase--succeed) :pcase--fail)
((eq x :pcase--fail) :pcase--succeed)))))
(cons (funcall reverse (car res))
(funcall reverse (cdr res)))))
((and (eq 'pred (car upat))
(let ((otherpred
(cond ((eq 'pred (car-safe pat)) (cadr pat))
@ -728,8 +754,10 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--funcall (fun arg vars)
"Build a function call to FUN with arg ARG."
(if (symbolp fun)
`(,fun ,arg)
(cond
((symbolp fun) `(,fun ,arg))
((eq 'not (car-safe fun)) `(not ,(pcase--funcall (cadr fun) arg vars)))
(t
(let* (;; `env' is an upper bound on the bindings we need.
(env (mapcar (lambda (x) (list (car x) (cdr x)))
(macroexp--fgrep vars fun)))
@ -747,7 +775,7 @@ MATCH is the pattern that needs to be matched, of the form:
;; Let's not replace `vars' in `fun' since it's
;; too difficult to do it right, instead just
;; let-bind `vars' around `fun'.
`(let* ,env ,call)))))
`(let* ,env ,call))))))
(defun pcase--eval (exp vars)
"Build an expression that will evaluate EXP."

7
lisp/emacs-lisp/radix-tree.el
View file

@ -198,9 +198,10 @@ If not found, return nil."
(pcase-defmacro radix-tree-leaf (vpat)
"Pattern which matches a radix-tree leaf.
The pattern VPAT is matched against the leaf's carried value."
;; FIXME: We'd like to use a negative pattern (not consp), but pcase
;; doesn't support it. Using `atom' works but generates sub-optimal code.
`(or `(t . ,,vpat) (and (pred atom) ,vpat))))
;; We used to use `(pred atom)', but `pcase' doesn't understand that
;; `atom' is equivalent to the negation of `consp' and hence generates
;; suboptimal code.
`(or `(t . ,,vpat) (and (pred (not consp)) ,vpat))))
(defun radix-tree-iter-subtrees (tree fun)
"Apply FUN to every immediate subtree of radix TREE.

22
lisp/emacs-lisp/subr-x.el
View file

@ -389,6 +389,28 @@ it makes no sense to convert it to a string using
(set-buffer source-buffer)
(replace-buffer-contents tmp-buffer max-secs max-costs)))))))))
(defmacro named-let (name bindings &rest body)
"Looping construct taken from Scheme.
Like `let', bind variables in BINDINGS and then evaluate BODY,
but with the twist that BODY can evaluate itself recursively by
calling NAME, where the arguments passed to NAME are used
as the new values of the bound variables in the recursive invocation."
(declare (indent 2) (debug (symbolp (&rest (symbolp form)) body)))
(require 'cl-lib)
(let ((fargs (mapcar (lambda (b) (if (consp b) (car b) b)) bindings))
(aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings)))
;; According to the Scheme semantics of named let, `name' is not in scope
;; while evaluating the expressions in `bindings', and for this reason, the
;; "initial" function call below needs to be outside of the `cl-labels'.
;; When the "self-tco" eliminates all recursive calls, the `cl-labels'
;; expands to a lambda which the byte-compiler then combines with the
;; funcall to make a `let' so we end up with a plain `while' loop and no
;; remaining `lambda' at all.
`(funcall
(cl-labels ((,name ,fargs . ,body)) #',name)
. ,aargs)))
(provide 'subr-x)
;;; subr-x.el ends here