* lisp/emacs-lisp/macroexp.el (macroexp--fgrep): Rename from `pcase--fgrep`

* lisp/emacs-lisp/cl-generic.el (cl--generic-fgrep): Delete.
(cl--generic-lambda): Use `macroexp--pacse` instead.

* lisp/emacs-lisp/pcase.el (pcase--fgrep): Rename to `macroexp--fgrep`.

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 19dd54c86452f6ca3a26d02c24d4211f600db5e9..529de9346d08e8d4bc19974d0388c84bcdda4da7 100644 (file)
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -304,15 +304,6 @@ the specializer used will be the one returned by BODY."
           (lambda ,args ,@body))))
 
 (eval-and-compile         ;Needed while compiling the cl-defmethod calls below!
-  (defun cl--generic-fgrep (vars sexp)    ;Copied from pcase.el.
-    "Check which of the symbols VARS appear in SEXP."
-    (let ((res '()))
-      (while (consp sexp)
-        (dolist (var (cl--generic-fgrep vars (pop sexp)))
-          (unless (memq var res) (push var res))))
-      (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
-      res))
-
   (defun cl--generic-split-args (args)
     "Return (SPEC-ARGS . PLAIN-ARGS)."
     (let ((plain-args ())
@@ -375,7 +366,7 @@ the specializer used will be the one returned by BODY."
                 ;; is used.
                 ;; FIXME: Also, optimize the case where call-next-method is
                 ;; only called with explicit arguments.
-                (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
+                (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
            (cons (not (not uses-cnm))
                  `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
                       ,@(car parsed-body)
@@ -617,11 +608,11 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
             (lambda (,@fixedargs &rest args)
               (let ,bindings
                 (apply (cl--generic-with-memoization
-                        (gethash ,tag-exp method-cache)
-                        (cl--generic-cache-miss
-                         generic ',dispatch-arg dispatches-left methods
-                         ,(if (cdr typescodes)
-                              `(append ,@typescodes) (car typescodes))))
+                           (gethash ,tag-exp method-cache)
+                         (cl--generic-cache-miss
+                          generic ',dispatch-arg dispatches-left methods
+                          ,(if (cdr typescodes)
+                               `(append ,@typescodes) (car typescodes))))
                        ,@fixedargs args)))))))))
 
 (defun cl--generic-make-function (generic)
@@ -1110,7 +1101,8 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
   (if (not (eq (car-safe specializer) 'head))
       (cl-call-next-method)
     (cl--generic-with-memoization
-        (gethash (cadr specializer) cl--generic-head-used) specializer)
+        (gethash (cadr specializer) cl--generic-head-used)
+      specializer)
     (list cl--generic-head-generalizer)))
 
 (cl--generic-prefill-dispatchers 0 (head eql))

diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 82a8cd2d77704d18c8827d2ce5381fa7454768d0..d5fda528b4f8560a7abd2c737f98e111f868f176 100644 (file)
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -480,6 +480,35 @@ itself or not."
       v
     (list 'quote v)))
 
+(defun macroexp--fgrep (bindings sexp)
+  "Return those of the BINDINGS which might be used in SEXP.
+It is used as a poor-man's \"free variables\" test.  It differs from a true
+test of free variables in the following ways:
+- It does not distinguish variables from functions, so it can be used
+  both to detect whether a given variable is used by SEXP and to
+  detect whether a given function is used by SEXP.
+- It does not actually know ELisp syntax, so it only looks for the presence
+  of symbols in SEXP and can't distinguish if those symbols are truly
+  references to the given variable (or function).  That can make the result
+  include bindings which actually aren't used.
+- For the same reason it may cause the result to fail to include bindings
+  which will be used if SEXP is not yet fully macro-expanded and the
+  use of the binding will only be revealed by macro expansion."
+  (let ((res '()))
+    (while (and (consp sexp) bindings)
+      (dolist (binding (macroexp--fgrep bindings (pop sexp)))
+        (push binding res)
+        (setq bindings (remove binding bindings))))
+    (if (vectorp sexp)
+        ;; With backquote, code can appear within vectors as well.
+        ;; This wouldn't be needed if we `macroexpand-all' before
+        ;; calling macroexp--fgrep, OTOH.
+        (macroexp--fgrep bindings (mapcar #'identity sexp))
+      (let ((tmp (assq sexp bindings)))
+        (if tmp
+            (cons tmp res)
+          res)))))
+
 ;;; Load-time macro-expansion.
 
 ;; Because macro-expansion used to be more lazy, eager macro-expansion

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 8fb79d220deef1f0133e4a1dce4c5515b5e84120..72ea1ba018855c4f3fc619805622fb1d797005ba 100644 (file)
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -344,7 +344,7 @@ of the elements of LIST is performed as if by `pcase-let'.
            (seen '())
            (codegen
             (lambda (code vars)
-              (let ((vars (pcase--fgrep vars code))
+              (let ((vars (macroexp--fgrep vars code))
                     (prev (assq code seen)))
                 (if (not prev)
                     (let ((res (pcase-codegen code vars)))
@@ -401,7 +401,7 @@ of the elements of LIST is performed as if by `pcase-let'.
                                  ;; occurrences of this leaf since it's small.
                                  (lambda (code vars)
                                    (pcase-codegen code
-                                                  (pcase--fgrep vars code)))
+                                                  (macroexp--fgrep vars code)))
                                codegen)
                              (cdr case)
                              vars))))
@@ -668,7 +668,7 @@ MATCH is the pattern that needs to be matched, of the form:
                ;; run, but we don't have the environment in which `pat' will
                ;; run, so we can't do a reliable verification.  But let's try
                ;; and catch at least the easy cases such as (bug#14773).
-               (not (pcase--fgrep (mapcar #'car vars) (cadr upat)))))
+               (not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
       '(:pcase--succeed . :pcase--fail))
      ((and (eq 'pred (car upat))
            (let ((otherpred
@@ -692,23 +692,6 @@ MATCH is the pattern that needs to be matched, of the form:
           '(nil . :pcase--fail)
         '(:pcase--fail . nil))))))
 
-(defun pcase--fgrep (bindings sexp)
-  "Return those of the BINDINGS which might be used in SEXP."
-  (let ((res '()))
-    (while (and (consp sexp) bindings)
-      (dolist (binding (pcase--fgrep bindings (pop sexp)))
-        (push binding res)
-        (setq bindings (remove binding bindings))))
-    (if (vectorp sexp)
-        ;; With backquote, code can appear within vectors as well.
-        ;; This wouldn't be needed if we `macroexpand-all' before
-        ;; calling pcase--fgrep, OTOH.
-        (pcase--fgrep bindings (mapcar #'identity sexp))
-      (let ((tmp (assq sexp bindings)))
-        (if tmp
-            (cons tmp res)
-          res)))))
-
 (defun pcase--self-quoting-p (upat)
   (or (keywordp upat) (integerp upat) (stringp upat)))
 
@@ -749,7 +732,7 @@ MATCH is the pattern that needs to be matched, of the form:
       `(,fun ,arg)
     (let* (;; `env' is an upper bound on the bindings we need.
            (env (mapcar (lambda (x) (list (car x) (cdr x)))
-                        (pcase--fgrep vars fun)))
+                        (macroexp--fgrep vars fun)))
            (call (progn
                    (when (assq arg env)
                      ;; `arg' is shadowed by `env'.
@@ -770,7 +753,7 @@ MATCH is the pattern that needs to be matched, of the form:
   "Build an expression that will evaluate EXP."
   (let* ((found (assq exp vars)))
     (if found (cdr found)
-      (let* ((env (pcase--fgrep vars exp)))
+      (let* ((env (macroexp--fgrep vars exp)))
         (if env
             (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
                                    env)