From 698ff554ac2699ec48fefc85a1307cbc4a183b0d Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Wed, 26 Jun 2019 10:03:48 -0400
Subject: * lisp/calc/calc-ext.el (math-scalarp): Fix typo
---
lisp/emacs-lisp/pcase.el | 29 ++++++++++++++++++++++++++---
1 file changed, 26 insertions(+), 3 deletions(-)
(limited to 'lisp/emacs-lisp/pcase.el')
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index ae2cf8eb02f..07beb722fc3 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -97,11 +97,34 @@
(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"
+ (let ((em (assoc s (assq :pcase-macroexpander macroexpand-all-environment))))
+ (if em (cdr em)
+ (get s 'pcase-macroexpander))))
+
+(defmacro pcase-macrolet (bindings &rest body)
+ (let ((new-macros (if (consp (car-safe bindings))
+ (mapcar (lambda (binding)
+ (cons (car binding)
+ (eval (if (cddr binding)
+ `(lambda ,(cadr binding)
+ ,@(cddr binding))
+ (cadr binding))
+ lexical-binding)))
+ bindings)
+ (eval bindings lexical-binding)))
+ (old-pme (assq :pcase-macroexpander macroexpand-all-environment)))
+ (macroexpand-all (macroexp-progn body)
+ (cons (cons :pcase-macroexpander
+ (append new-macros old-pme))
+ macroexpand-all-environment))))
+
(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)))))
@@ -193,7 +216,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)))))
@@ -419,7 +442,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
--
cgit v1.2.3