diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 60 | ||||
| -rw-r--r-- | lisp/textmodes/mhtml-mode.el | 2 | ||||
| -rw-r--r-- | lisp/vc/diff-mode.el | 2 |
3 files changed, 38 insertions, 26 deletions
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index b1e1305edfe..0fa1b980a0f 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -328,8 +328,7 @@ of the elements of LIST is performed as if by `pcase-let'. (seen '()) (codegen (lambda (code vars) - (let ((vars (macroexp--fgrep vars code)) - (prev (assq code seen))) + (let ((prev (assq code seen))) (if (not prev) (let ((res (pcase-codegen code vars))) (push (list code vars res) seen) @@ -354,14 +353,14 @@ of the elements of LIST is performed as if by `pcase-let'. (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) defs) (setcar res 'funcall) - (setcdr res (cons bsym (mapcar #'cdr prevvars))) + (setcdr res (cons bsym (mapcar #'cadr prevvars))) (setcar (cddr prev) bsym) (setq res bsym))) (setq vars (copy-sequence vars)) (let ((args (mapcar (lambda (pa) (let ((v (assq (car pa) vars))) (setq vars (delq v vars)) - (cdr v))) + (cadr v))) prevvars))) ;; If some of `vars' were not found in `prevvars', that's ;; OK it just means those vars aren't present in all @@ -383,9 +382,7 @@ of the elements of LIST is performed as if by `pcase-let'. (if (pcase--small-branch-p (cdr case)) ;; Don't bother sharing multiple ;; occurrences of this leaf since it's small. - (lambda (code vars) - (pcase-codegen code - (macroexp--fgrep vars code))) + #'pcase-codegen codegen) (cdr case) vars)))) @@ -452,10 +449,15 @@ for the result of evaluating EXP (first arg to `pcase'). ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy ;; codegen from later metamorphosing this let into a funcall. - (if vars - `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) - ,@code) - `(progn ,@code))) + (if (null vars) + `(progn ,@code) + `(let ,(mapcar (lambda (b) (list (car b) (cadr b))) vars) + ;; Try and silence some of the most common spurious "unused + ;; var" warnings. + ,@(delq nil (mapcar (lambda (var) + (if (cddr var) `(ignore ,(car var)))) + vars)) + ,@code))) (defun pcase--small-branch-p (code) (and (= 1 (length code)) @@ -497,11 +499,14 @@ for the result of evaluating EXP (first arg to `pcase'). "Expand matcher for rules BRANCHES. Each BRANCH has the form (MATCH CODE . VARS) where CODE is the code generator for that branch. -VARS is the set of vars already bound by earlier matches. MATCH is the pattern that needs to be matched, of the form: (match VAR . PAT) (and MATCH ...) - (or MATCH ...)" + (or MATCH ...) +VARS is the set of vars already bound by earlier matches. +It is a list of (NAME VAL . USED) where NAME is the variable's symbol, +VAL is the expression to which it should be bound and USED is a boolean +recording whether the var has been referenced by earlier parts of the match." (when (setq branches (delq nil branches)) (let* ((carbranch (car branches)) (match (car carbranch)) (cdarbranch (cdr carbranch)) @@ -748,8 +753,11 @@ A and B can be one of: ((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))) + (let* (;; `env' is hopefully an upper bound on the bindings we need, + ;; FIXME: See bug#46786 for a counter example :-( + (env (mapcar (lambda (x) + (setcdr (cdr x) 'used) + (list (car x) (cadr x))) (macroexp--fgrep vars fun))) (call (progn (when (assq arg env) @@ -757,7 +765,7 @@ A and B can be one of: (let ((newsym (gensym "x"))) (push (list newsym arg) env) (setq arg newsym))) - (if (functionp fun) + (if (or (functionp fun) (not (consp fun))) `(funcall #',fun ,arg) `(,@fun ,arg))))) (if (null env) @@ -770,10 +778,12 @@ A and B can be one of: (defun pcase--eval (exp vars) "Build an expression that will evaluate EXP." (let* ((found (assq exp vars))) - (if found (cdr found) + (if found (progn (setcdr (cdr found) 'used) (cadr found)) (let* ((env (macroexp--fgrep vars exp))) (if env - (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x))) + (macroexp-let* (mapcar (lambda (x) + (setcdr (cdr x) 'used) + (list (car x) (cadr x))) env) exp) exp))))) @@ -865,12 +875,14 @@ Otherwise, it defers to REST which is a list of branches of the form (pcase--u else-rest)))) ((and (symbolp upat) upat) (pcase--mark-used sym) - (if (not (assq upat vars)) - (pcase--u1 matches code (cons (cons upat sym) vars) rest) - ;; Non-linear pattern. Turn it into an `eq' test. - (pcase--u1 (cons `(match ,sym . (pred (eql ,(cdr (assq upat vars))))) - matches) - code vars rest))) + (let ((v (assq upat vars))) + (if (not v) + (pcase--u1 matches code (cons (list upat sym) vars) rest) + ;; Non-linear pattern. Turn it into an `eq' test. + (setq (cddr v) 'used) + (pcase--u1 (cons `(match ,sym . (pred (eql ,(cadr v)))) + matches) + code vars rest)))) ((eq (car-safe upat) 'app) ;; A upat of the form (app FUN PAT) (pcase--mark-used sym) diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el index 32542d0400f..25905385685 100644 --- a/lisp/textmodes/mhtml-mode.el +++ b/lisp/textmodes/mhtml-mode.el @@ -313,7 +313,7 @@ Prefix arg specifies how many times to move (default 1)." (interactive "P") (pcase (get-text-property (point) 'mhtml-submode) ('nil (sgml-skip-tag-forward arg)) - (submode (forward-sexp arg)))) + (_submode (forward-sexp arg)))) ;;;###autoload (define-derived-mode mhtml-mode html-mode diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 8bbab467af3..342b4cc32b1 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2003,7 +2003,7 @@ revision of the file otherwise." (if event (posn-set-point (event-end event))) (let ((buffer (when event (current-buffer))) (reverse (not (save-excursion (beginning-of-line) (looking-at "[-<]"))))) - (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched) + (pcase-let ((`(,buf ,_line-offset ,pos ,src ,_dst ,_switched) (diff-find-source-location other-file reverse))) (pop-to-buffer buf) (goto-char (+ (car pos) (cdr src))) |