mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-24 06:20:43 -08:00
More CL cleanups and reduction of use of cl.el.
* woman.el, winner.el, vc/vc-rcs.el, vc/vc-hooks.el, vc/vc-hg.el: * vc/vc-git.el, vc/vc-dir.el, vc/vc-bzr.el, vc/vc-annotate.el: * textmodes/tex-mode.el, textmodes/sgml-mode.el, tar-mode.el: * strokes.el, ses.el, server.el, progmodes/js.el, progmodes/gdb-mi.el: * progmodes/flymake.el, progmodes/ebrowse.el, progmodes/compile.el: * play/tetris.el, play/snake.el, play/pong.el, play/landmark.el: * play/hanoi.el, play/decipher.el, play/5x5.el, nxml/nxml-mode.el: * net/secrets.el, net/quickurl.el, midnight.el, mail/footnote.el: * image-dired.el, ibuffer.el, ibuf-macs.el, ibuf-ext.el, hexl.el: * eshell/eshell.el, eshell/esh-io.el, eshell/esh-ext.el: * eshell/esh-cmd.el, eshell/em-ls.el, eshell/em-hist.el: * eshell/em-cmpl.el, eshell/em-banner.el: * url/url.el, url/url-queue.el, url/url-parse.el, url/url-http.el: * url/url-future.el, url/url-dav.el, url/url-cookie.el: * calendar/parse-time.el, test/eshell.el: Use cl-lib. * wid-browse.el, wdired.el, vc/vc.el, vc/vc-mtn.el, vc/vc-cvs.el: * vc/vc-arch.el, tree-widget.el, textmodes/texinfo.el: * textmodes/refill.el, textmodes/css-mode.el, term/tvi970.el: * term/ns-win.el, term.el, shell.el, ps-samp.el: * progmodes/perl-mode.el, progmodes/pascal.el, progmodes/gud.el: * progmodes/glasses.el, progmodes/etags.el, progmodes/cwarn.el: * play/gamegrid.el, play/bubbles.el, novice.el, notifications.el: * net/zeroconf.el, net/xesam.el, net/snmp-mode.el, net/mairix.el: * net/ldap.el, net/eudc.el, net/browse-url.el, man.el: * mail/mailheader.el, mail/feedmail.el: * url/url-util.el, url/url-privacy.el, url/url-nfs.el, url/url-misc.el: * url/url-methods.el, url/url-gw.el, url/url-file.el, url/url-expand.el: Dont use CL. * ibuf-ext.el (ibuffer-mark-old-buffers): Use float-time. * eshell/esh-opt.el (eshell-eval-using-options): Quote code with `lambda' rather than with `quote'. (eshell-do-opt): Adjust accordingly. (eshell-process-option): Simplify. * eshell/esh-var.el: * eshell/em-script.el: Require `esh-opt' for eshell-eval-using-options. * emacs-pcase.el (pcase--dontcare-upats, pcase--let*) (pcase--expand, pcase--u1): Rename pcase's internal `dontcare' pattern to `pcase--dontcare'. * emacs-cl.el (labels): Mark obsolete. (cl--letf, letf): Move to cl-lib. (cl--letf*, letf*): Remove. * emacs-cl-lib.el (cl-nth-value): Use defalias. * emacs-cl-macs.el (cl-dolist, cl-dotimes): Add indent rule. (cl-progv): Rewrite. (cl--letf, cl-letf): Move from cl.el. (cl-letf*): New macro. * emacs-cl-extra.el (cl--progv-before, cl--progv-after): Remove.
This commit is contained in:
Stefan Monnier
parent
c214e35e48
commit
a464a6c73a
109 changed files with 2297 additions and 2349 deletions
|
|
@ -313,25 +313,6 @@ If so, return the true (non-nil) value returned by PREDICATE.
|
|||
(t (make-frame-visible frame)))
|
||||
val)
|
||||
|
||||
;;; Support for `cl-progv'.
|
||||
(defvar cl--progv-save)
|
||||
;;;###autoload
|
||||
(defun cl--progv-before (syms values)
|
||||
(while syms
|
||||
(push (if (boundp (car syms))
|
||||
(cons (car syms) (symbol-value (car syms)))
|
||||
(car syms)) cl--progv-save)
|
||||
(if values
|
||||
(set (pop syms) (pop values))
|
||||
(makunbound (pop syms)))))
|
||||
|
||||
(defun cl--progv-after ()
|
||||
(while cl--progv-save
|
||||
(if (consp (car cl--progv-save))
|
||||
(set (car (car cl--progv-save)) (cdr (car cl--progv-save)))
|
||||
(makunbound (car cl--progv-save)))
|
||||
(pop cl--progv-save)))
|
||||
|
||||
|
||||
;;; Numbers.
|
||||
|
||||
|
|
|
|||
|
|
@ -230,12 +230,13 @@ one value."
|
|||
"Apply FUNCTION to ARGUMENTS, taking multiple values into account.
|
||||
This implementation only handles the case where there is only one argument.")
|
||||
|
||||
(defsubst cl-nth-value (n expression)
|
||||
(cl--defalias 'cl-nth-value #'nth
|
||||
"Evaluate EXPRESSION to get multiple values and return the Nth one.
|
||||
This handles multiple values in Common Lisp style, but it does not work
|
||||
right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
|
||||
one value."
|
||||
(nth n expression))
|
||||
one value.
|
||||
|
||||
\(fn N EXPRESSION)")
|
||||
|
||||
;;; Declarations.
|
||||
|
||||
|
|
|
|||
|
|
@ -624,7 +624,7 @@ Key values are compared by `eql'.
|
|||
|
||||
;;;###autoload
|
||||
(defmacro cl-ecase (expr &rest clauses)
|
||||
"Like `cl-case', but error if no cl-case fits.
|
||||
"Like `cl-case', but error if no case fits.
|
||||
`otherwise'-clauses are not allowed.
|
||||
\n(fn EXPR (KEYLIST BODY...)...)"
|
||||
(declare (indent 1) (debug cl-case))
|
||||
|
|
@ -1482,7 +1482,8 @@ Then evaluate RESULT to get return value, default nil.
|
|||
An implicit nil block is established around the loop.
|
||||
|
||||
\(fn (VAR LIST [RESULT]) BODY...)"
|
||||
(declare (debug ((symbolp form &optional form) cl-declarations body)))
|
||||
(declare (debug ((symbolp form &optional form) cl-declarations body))
|
||||
(indent 1))
|
||||
`(cl-block nil
|
||||
(,(if (eq 'cl-dolist (symbol-function 'dolist)) 'cl--dolist 'dolist)
|
||||
,spec ,@body)))
|
||||
|
|
@ -1495,7 +1496,7 @@ to COUNT, exclusive. Then evaluate RESULT to get return value, default
|
|||
nil.
|
||||
|
||||
\(fn (VAR COUNT [RESULT]) BODY...)"
|
||||
(declare (debug cl-dolist))
|
||||
(declare (debug cl-dolist) (indent 1))
|
||||
`(cl-block nil
|
||||
(,(if (eq 'cl-dotimes (symbol-function 'dotimes)) 'cl--dotimes 'dotimes)
|
||||
,spec ,@body)))
|
||||
|
|
@ -1546,10 +1547,19 @@ second list (or made unbound if VALUES is shorter than SYMBOLS); then the
|
|||
BODY forms are executed and their result is returned. This is much like
|
||||
a `let' form, except that the list of symbols can be computed at run-time."
|
||||
(declare (indent 2) (debug (form form body)))
|
||||
`(let ((cl--progv-save nil))
|
||||
(unwind-protect
|
||||
(progn (cl--progv-before ,symbols ,values) ,@body)
|
||||
(cl--progv-after))))
|
||||
(let ((bodyfun (make-symbol "body"))
|
||||
(binds (make-symbol "binds"))
|
||||
(syms (make-symbol "syms"))
|
||||
(vals (make-symbol "vals")))
|
||||
`(progn
|
||||
(defvar ,bodyfun)
|
||||
(let* ((,syms ,symbols)
|
||||
(,vals ,values)
|
||||
(,bodyfun (lambda () ,@body))
|
||||
(,binds ()))
|
||||
(while ,syms
|
||||
(push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds))
|
||||
(eval (list 'let ,binds '(funcall ,bodyfun)))))))
|
||||
|
||||
(defvar cl--labels-convert-cache nil)
|
||||
|
||||
|
|
@ -1600,7 +1610,7 @@ Like `cl-labels' but the definitions are not recursive.
|
|||
Like `cl-flet' but the definitions can refer to previous ones.
|
||||
|
||||
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
|
||||
(declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
|
||||
(declare (indent 1) (debug cl-flet))
|
||||
(cond
|
||||
((null bindings) (macroexp-progn body))
|
||||
((null (cdr bindings)) `(cl-flet ,bindings ,@body))
|
||||
|
|
@ -1609,7 +1619,8 @@ Like `cl-flet' but the definitions can refer to previous ones.
|
|||
;;;###autoload
|
||||
(defmacro cl-labels (bindings &rest body)
|
||||
"Make temporary function bindings.
|
||||
The bindings can be recursive. Assumes the use of `lexical-binding'.
|
||||
The bindings can be recursive and the scoping is lexical, but capturing them
|
||||
in closures will only work if `lexical-binding' is in use.
|
||||
|
||||
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
|
||||
(declare (indent 1) (debug cl-flet))
|
||||
|
|
@ -1911,6 +1922,86 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
|
|||
(macroexp-let* `((,temp ,getter))
|
||||
`(progn ,(funcall setter form) nil))))))
|
||||
|
||||
;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
|
||||
;; previous state. If the getter/setter loses information, that info is
|
||||
;; not recovered.
|
||||
|
||||
(defun cl--letf (bindings simplebinds binds body)
|
||||
;; It's not quite clear what the semantics of cl-letf should be.
|
||||
;; E.g. in (cl-letf ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
|
||||
;; that the actual assignments ("bindings") should only happen after
|
||||
;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of
|
||||
;; PLACE1 and PLACE2 should be evaluated. Should we have
|
||||
;; PLACE1; VAL1; PLACE2; VAL2; bind1; bind2
|
||||
;; or
|
||||
;; VAL1; VAL2; PLACE1; PLACE2; bind1; bind2
|
||||
;; or
|
||||
;; VAL1; VAL2; PLACE1; bind1; PLACE2; bind2
|
||||
;; Common-Lisp's `psetf' does the first, so we'll do the same.
|
||||
(if (null bindings)
|
||||
(if (and (null binds) (null simplebinds)) (macroexp-progn body)
|
||||
`(let* (,@(mapcar (lambda (x)
|
||||
(pcase-let ((`(,vold ,getter ,_setter ,_vnew) x))
|
||||
(list vold getter)))
|
||||
binds)
|
||||
,@simplebinds)
|
||||
(unwind-protect
|
||||
,(macroexp-progn
|
||||
(append
|
||||
(delq nil
|
||||
(mapcar (lambda (x)
|
||||
(pcase x
|
||||
;; If there's no vnew, do nothing.
|
||||
(`(,_vold ,_getter ,setter ,vnew)
|
||||
(funcall setter vnew))))
|
||||
binds))
|
||||
body))
|
||||
,@(mapcar (lambda (x)
|
||||
(pcase-let ((`(,vold ,_getter ,setter ,_vnew) x))
|
||||
(funcall setter vold)))
|
||||
binds))))
|
||||
(let ((binding (car bindings)))
|
||||
(gv-letplace (getter setter) (car binding)
|
||||
(macroexp-let2 nil vnew (cadr binding)
|
||||
(if (symbolp (car binding))
|
||||
;; Special-case for simple variables.
|
||||
(cl--letf (cdr bindings)
|
||||
(cons `(,getter ,(if (cdr binding) vnew getter))
|
||||
simplebinds)
|
||||
binds body)
|
||||
(cl--letf (cdr bindings) simplebinds
|
||||
(cons `(,(make-symbol "old") ,getter ,setter
|
||||
,@(if (cdr binding) (list vnew)))
|
||||
binds)
|
||||
body)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro cl-letf (bindings &rest body)
|
||||
"Temporarily bind to PLACEs.
|
||||
This is the analogue of `let', but with generalized variables (in the
|
||||
sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
|
||||
VALUE, then the BODY forms are executed. On exit, either normally or
|
||||
because of a `throw' or error, the PLACEs are set back to their original
|
||||
values. Note that this macro is *not* available in Common Lisp.
|
||||
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
|
||||
the PLACE is not modified before executing BODY.
|
||||
|
||||
\(fn ((PLACE VALUE) ...) BODY...)"
|
||||
(declare (indent 1) (debug ((&rest (gate gv-place &optional form)) body)))
|
||||
(if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
|
||||
`(let ,bindings ,@body)
|
||||
(cl--letf bindings () () body)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro cl-letf* (bindings &rest body)
|
||||
"Temporarily bind to PLACEs.
|
||||
Like `cl-letf' but where the bindings are performed one at a time,
|
||||
rather than all at the end (i.e. like `let*' rather than like `let')."
|
||||
(declare (indent 1) (debug cl-letf))
|
||||
(dolist (binding (reverse bindings))
|
||||
(setq body (list `(cl-letf (,binding) ,@body))))
|
||||
(macroexp-progn body))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro cl-callf (func place &rest args)
|
||||
"Set PLACE to (FUNC PLACE ARGS...).
|
||||
|
|
|
|||
|
|
@ -222,7 +222,7 @@
|
|||
callf2
|
||||
callf
|
||||
letf*
|
||||
letf
|
||||
;; letf
|
||||
rotatef
|
||||
shiftf
|
||||
remf
|
||||
|
|
@ -449,16 +449,6 @@ Common Lisp.
|
|||
(setq body (list `(lexical-let (,(pop bindings)) ,@body))))
|
||||
(car body)))
|
||||
|
||||
(defmacro cl--symbol-function (symbol)
|
||||
"Like `symbol-function' but return `cl--unbound' if not bound."
|
||||
;; (declare (gv-setter (lambda (store)
|
||||
;; `(if (eq ,store 'cl--unbound)
|
||||
;; (fmakunbound ,symbol) (fset ,symbol ,store)))))
|
||||
`(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound))
|
||||
(gv-define-setter cl--symbol-function (store symbol)
|
||||
`(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store)))
|
||||
|
||||
|
||||
;; This should really have some way to shadow 'byte-compile properties, etc.
|
||||
(defmacro flet (bindings &rest body)
|
||||
"Make temporary overriding function definitions.
|
||||
|
|
@ -470,38 +460,36 @@ then the definitions are undone (the FUNCs go back to their previous
|
|||
definitions, or lack thereof).
|
||||
|
||||
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
|
||||
(declare (indent 1) (debug cl-flet))
|
||||
`(letf* ,(mapcar
|
||||
(lambda (x)
|
||||
(if (or (and (fboundp (car x))
|
||||
(eq (car-safe (symbol-function (car x))) 'macro))
|
||||
(cdr (assq (car x) macroexpand-all-environment)))
|
||||
(error "Use `labels', not `flet', to rebind macro names"))
|
||||
(let ((func `(cl-function
|
||||
(lambda ,(cadr x)
|
||||
(cl-block ,(car x) ,@(cddr x))))))
|
||||
(when (cl--compiling-file)
|
||||
;; Bug#411. It would be nice to fix this.
|
||||
(and (get (car x) 'byte-compile)
|
||||
(error "Byte-compiling a redefinition of `%s' \
|
||||
(declare (indent 1) (debug cl-flet)
|
||||
(obsolete "Use either `cl-flet' or `cl-letf'." "24.2"))
|
||||
`(letf ,(mapcar
|
||||
(lambda (x)
|
||||
(if (or (and (fboundp (car x))
|
||||
(eq (car-safe (symbol-function (car x))) 'macro))
|
||||
(cdr (assq (car x) macroexpand-all-environment)))
|
||||
(error "Use `labels', not `flet', to rebind macro names"))
|
||||
(let ((func `(cl-function
|
||||
(lambda ,(cadr x)
|
||||
(cl-block ,(car x) ,@(cddr x))))))
|
||||
(when (cl--compiling-file)
|
||||
;; Bug#411. It would be nice to fix this.
|
||||
(and (get (car x) 'byte-compile)
|
||||
(error "Byte-compiling a redefinition of `%s' \
|
||||
will not work - use `labels' instead" (symbol-name (car x))))
|
||||
;; FIXME This affects the rest of the file, when it
|
||||
;; should be restricted to the flet body.
|
||||
(and (boundp 'byte-compile-function-environment)
|
||||
(push (cons (car x) (eval func))
|
||||
byte-compile-function-environment)))
|
||||
(list `(symbol-function ',(car x)) func)))
|
||||
bindings)
|
||||
;; FIXME This affects the rest of the file, when it
|
||||
;; should be restricted to the flet body.
|
||||
(and (boundp 'byte-compile-function-environment)
|
||||
(push (cons (car x) (eval func))
|
||||
byte-compile-function-environment)))
|
||||
(list `(symbol-function ',(car x)) func)))
|
||||
bindings)
|
||||
,@body))
|
||||
(make-obsolete 'flet "Use either `cl-flet' or `letf'." "24.2")
|
||||
|
||||
(defmacro labels (bindings &rest body)
|
||||
"Make temporary function bindings.
|
||||
This is like `flet', except the bindings are lexical instead of dynamic.
|
||||
Unlike `flet', this macro is fully compliant with the Common Lisp standard.
|
||||
|
||||
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
|
||||
(declare (indent 1) (debug cl-flet))
|
||||
Like `cl-labels' except that the lexical scoping is handled via `lexical-let'
|
||||
rather than relying on `lexical-binding'."
|
||||
(declare (indent 1) (debug cl-flet) (obsolete 'cl-labels "24.2"))
|
||||
(let ((vars nil) (sets nil) (newenv macroexpand-all-environment))
|
||||
(dolist (binding bindings)
|
||||
;; It's important that (not (eq (symbol-name var1) (symbol-name var2)))
|
||||
|
|
@ -521,93 +509,24 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard.
|
|||
;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we
|
||||
;; still need to support old users of cl.el.
|
||||
|
||||
;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
|
||||
;; previous state. If the getter/setter loses information, that info is
|
||||
;; not recovered.
|
||||
|
||||
(defun cl--letf (bindings simplebinds binds body)
|
||||
;; It's not quite clear what the semantics of let! should be.
|
||||
;; E.g. in (let! ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
|
||||
;; that the actual assignments ("bindings") should only happen after
|
||||
;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of
|
||||
;; PLACE1 and PLACE2 should be evaluated. Should we have
|
||||
;; PLACE1; VAL1; PLACE2; VAL2; bind1; bind2
|
||||
;; or
|
||||
;; VAL1; VAL2; PLACE1; PLACE2; bind1; bind2
|
||||
;; or
|
||||
;; VAL1; VAL2; PLACE1; bind1; PLACE2; bind2
|
||||
;; Common-Lisp's `psetf' does the first, so we'll do the same.
|
||||
(if (null bindings)
|
||||
(if (and (null binds) (null simplebinds)) (macroexp-progn body)
|
||||
`(let* (,@(mapcar (lambda (x)
|
||||
(pcase-let ((`(,vold ,getter ,_setter ,_vnew) x))
|
||||
(list vold getter)))
|
||||
binds)
|
||||
,@simplebinds)
|
||||
(unwind-protect
|
||||
,(macroexp-progn (append
|
||||
(mapcar (lambda (x) (pcase x
|
||||
(`(,_vold ,_getter ,setter ,vnew)
|
||||
(funcall setter vnew))))
|
||||
binds)
|
||||
body))
|
||||
,@(mapcar (lambda (x) (pcase-let ((`(,vold ,_getter ,setter ,_vnew) x))
|
||||
(funcall setter vold)))
|
||||
binds))))
|
||||
(let ((binding (car bindings)))
|
||||
(if (eq (car-safe (car binding)) 'symbol-function)
|
||||
(setcar (car binding) 'cl--symbol-function))
|
||||
(gv-letplace (getter setter) (car binding)
|
||||
(macroexp-let2 nil vnew (cadr binding)
|
||||
(if (symbolp (car binding))
|
||||
;; Special-case for simple variables.
|
||||
(cl--letf (cdr bindings)
|
||||
(cons `(,getter ,(if (cdr binding) vnew getter))
|
||||
simplebinds)
|
||||
binds body)
|
||||
(cl--letf (cdr bindings) simplebinds
|
||||
(cons `(,(make-symbol "old") ,getter ,setter
|
||||
,@(if (cdr binding) (list vnew)))
|
||||
binds)
|
||||
body)))))))
|
||||
(defmacro cl--symbol-function (symbol)
|
||||
"Like `symbol-function' but return `cl--unbound' if not bound."
|
||||
;; (declare (gv-setter (lambda (store)
|
||||
;; `(if (eq ,store 'cl--unbound)
|
||||
;; (fmakunbound ,symbol) (fset ,symbol ,store)))))
|
||||
`(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound))
|
||||
(gv-define-setter cl--symbol-function (store symbol)
|
||||
`(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store)))
|
||||
|
||||
(defmacro letf (bindings &rest body)
|
||||
"Temporarily bind to PLACEs.
|
||||
This is the analogue of `let', but with generalized variables (in the
|
||||
sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
|
||||
VALUE, then the BODY forms are executed. On exit, either normally or
|
||||
because of a `throw' or error, the PLACEs are set back to their original
|
||||
values. Note that this macro is *not* available in Common Lisp.
|
||||
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
|
||||
the PLACE is not modified before executing BODY.
|
||||
|
||||
\(fn ((PLACE VALUE) ...) BODY...)"
|
||||
(declare (indent 1) (debug ((&rest (gate gv-place &optional form)) body)))
|
||||
(cl--letf bindings () () body))
|
||||
|
||||
(defun cl--letf* (bindings body)
|
||||
(if (null bindings)
|
||||
(macroexp-progn body)
|
||||
(let ((binding (car bindings)))
|
||||
(if (symbolp (car binding))
|
||||
;; Special-case for simple variables.
|
||||
(macroexp-let* (list (if (cdr binding) binding
|
||||
(list (car binding) (car binding))))
|
||||
(cl--letf* (cdr bindings) body))
|
||||
(if (eq (car-safe (car binding)) 'symbol-function)
|
||||
(setcar (car binding) 'cl--symbol-function))
|
||||
(gv-letplace (getter setter) (car binding)
|
||||
(macroexp-let2 macroexp-copyable-p vnew (cadr binding)
|
||||
(macroexp-let2 nil vold getter
|
||||
`(unwind-protect
|
||||
(progn
|
||||
,(if (cdr binding) (funcall setter vnew))
|
||||
,(cl--letf* (cdr bindings) body))
|
||||
,(funcall setter vold)))))))))
|
||||
|
||||
(defmacro letf* (bindings &rest body)
|
||||
(declare (indent 1) (debug letf))
|
||||
(cl--letf* bindings body))
|
||||
"Dynamically scoped let-style bindings for places.
|
||||
Like `cl-letf', but with some extra backward compatibility."
|
||||
;; Like cl-letf, but with special handling of symbol-function.
|
||||
`(cl-letf ,(mapcar (lambda (x) (if (eq (car-safe (car x)) 'symbol-function)
|
||||
`((cl--symbol-function ,@(cdar x)) ,@(cdr x))
|
||||
x))
|
||||
bindings)
|
||||
,@body))
|
||||
|
||||
(defun cl--gv-adapt (cl-gv do)
|
||||
;; This function is used by all .elc files that use define-setf-expander and
|
||||
|
|
|
|||
|
|
@ -466,6 +466,9 @@ Return nil if there are no more forms, t otherwise."
|
|||
(add-to-list 'elint-features name)
|
||||
;; cl loads cl-macs in an opaque manner.
|
||||
;; Since cl-macs requires cl, we can just process cl-macs.
|
||||
;; FIXME: AFAIK, `cl' now behaves properly and does not need any
|
||||
;; special treatment any more. Can someone who understands this
|
||||
;; code confirm? --Stef
|
||||
(and (eq name 'cl) (not elint-doing-cl)
|
||||
;; We need cl if elint-form is to be able to expand cl macros.
|
||||
(require 'cl)
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@
|
|||
;; (defconst pcase--memoize-1 (make-hash-table :test 'eq))
|
||||
;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal))
|
||||
|
||||
(defconst pcase--dontcare-upats '(t _ dontcare))
|
||||
(defconst pcase--dontcare-upats '(t _ pcase--dontcare))
|
||||
|
||||
(def-edebug-spec
|
||||
pcase-UPAT
|
||||
|
|
@ -154,11 +154,12 @@ like `(,a . ,(pred (< a))) or, with more checks:
|
|||
(pcase--expand
|
||||
(cadr binding)
|
||||
`((,(car binding) ,(pcase--let* bindings body))
|
||||
;; We can either signal an error here, or just use `dontcare' which
|
||||
;; generates more efficient code. In practice, if we use `dontcare'
|
||||
;; we will still often get an error and the few cases where we don't
|
||||
;; do not matter that much, so it's a better choice.
|
||||
(dontcare nil)))))))
|
||||
;; We can either signal an error here, or just use `pcase--dontcare'
|
||||
;; which generates more efficient code. In practice, if we use
|
||||
;; `pcase--dontcare' we will still often get an error and the few
|
||||
;; cases where we don't do not matter that much, so
|
||||
;; it's a better choice.
|
||||
(pcase--dontcare nil)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro pcase-let* (bindings &rest body)
|
||||
|
|
@ -275,7 +276,7 @@ of the form (UPAT EXP)."
|
|||
vars))))
|
||||
cases))))
|
||||
(dolist (case cases)
|
||||
(unless (or (memq case used-cases) (eq (car case) 'dontcare))
|
||||
(unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare))
|
||||
(message "Redundant pcase pattern: %S" (car case))))
|
||||
(macroexp-let* defs main))))
|
||||
|
||||
|
|
@ -575,7 +576,7 @@ Otherwise, it defers to REST which is a list of branches of the form
|
|||
(upat (cdr cdrpopmatches)))
|
||||
(cond
|
||||
((memq upat '(t _)) (pcase--u1 matches code vars rest))
|
||||
((eq upat 'dontcare) :pcase--dontcare)
|
||||
((eq upat 'pcase--dontcare) :pcase--dontcare)
|
||||
((memq (car-safe upat) '(guard pred))
|
||||
(if (eq (car upat) 'pred) (put sym 'pcase-used t))
|
||||
(let* ((splitrest
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue