Commit 768a3527 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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`.
parent a31bfd59
Pipeline #8573 failed with stage
in 120 minutes and 4 seconds
......@@ -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))
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment