New macro macroexp-let2*
* emacs-lisp/macroexp.el (macroexp-let2*): New macro. * window.el (with-temp-buffer-window) (with-current-buffer-window, with-displayed-buffer-window): * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin): * emacs-lisp/cl-lib.el (substring): * emacs-lisp/cl-extra.el (cl-getf): Use it.
This commit is contained in:
parent
d71a2d495f
commit
6dbaf04719
6 changed files with 76 additions and 60 deletions
|
@ -606,15 +606,14 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
|
|||
(declare (gv-expander
|
||||
(lambda (do)
|
||||
(gv-letplace (getter setter) plist
|
||||
(macroexp-let2 nil k tag
|
||||
(macroexp-let2 nil d def
|
||||
(funcall do `(cl-getf ,getter ,k ,d)
|
||||
(lambda (v)
|
||||
(macroexp-let2 nil val v
|
||||
`(progn
|
||||
,(funcall setter
|
||||
`(cl--set-getf ,getter ,k ,val))
|
||||
,val))))))))))
|
||||
(macroexp-let2* nil ((k tag) (d def))
|
||||
(funcall do `(cl-getf ,getter ,k ,d)
|
||||
(lambda (v)
|
||||
(macroexp-let2 nil val v
|
||||
`(progn
|
||||
,(funcall setter
|
||||
`(cl--set-getf ,getter ,k ,val))
|
||||
,val)))))))))
|
||||
(setplist '--cl-getf-symbol-- plist)
|
||||
(or (get '--cl-getf-symbol-- tag)
|
||||
;; Originally we called cl-get here,
|
||||
|
|
|
@ -723,12 +723,11 @@ If ALIST is non-nil, the new pairs are prepended to it."
|
|||
(gv-define-expander substring
|
||||
(lambda (do place from &optional to)
|
||||
(gv-letplace (getter setter) place
|
||||
(macroexp-let2 nil start from
|
||||
(macroexp-let2 nil end to
|
||||
(funcall do `(substring ,getter ,start ,end)
|
||||
(lambda (v)
|
||||
(funcall setter `(cl--set-substring
|
||||
,getter ,start ,end ,v)))))))))
|
||||
(macroexp-let2* nil ((start from) (end to))
|
||||
(funcall do `(substring ,getter ,start ,end)
|
||||
(lambda (v)
|
||||
(funcall setter `(cl--set-substring
|
||||
,getter ,start ,end ,v))))))))
|
||||
|
||||
;;; Miscellaneous.
|
||||
|
||||
|
|
|
@ -2906,9 +2906,8 @@ The function's arguments should be treated as immutable.
|
|||
;;;###autoload
|
||||
(defun cl--compiler-macro-adjoin (form a list &rest keys)
|
||||
(if (memq :key keys) form
|
||||
(macroexp-let2 macroexp-copyable-p va a
|
||||
(macroexp-let2 macroexp-copyable-p vlist list
|
||||
`(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist))))))
|
||||
(macroexp-let2* macroexp-copyable-p ((va a) (vlist list))
|
||||
`(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist)))))
|
||||
|
||||
(defun cl--compiler-macro-get (_form sym prop &optional def)
|
||||
(if def
|
||||
|
|
|
@ -344,6 +344,15 @@ be skipped; if nil, as is usual, `macroexp-const-p' is used."
|
|||
(macroexp-let* (list (list ,var ,expsym))
|
||||
,bodysym)))))
|
||||
|
||||
(defmacro macroexp-let2* (test bindings &rest body)
|
||||
"Bind each binding in BINDINGS as `macroexp-let2' does."
|
||||
(declare (indent 2) (debug (sexp (&rest (sexp form)) body)))
|
||||
(pcase-exhaustive bindings
|
||||
(`nil (macroexp-progn body))
|
||||
(`((,var ,exp) . ,tl)
|
||||
`(macroexp-let2 ,test ,var ,exp
|
||||
(macroexp-let2* ,test ,tl ,@body)))))
|
||||
|
||||
(defun macroexp--maxsize (exp size)
|
||||
(cond ((< size 0) size)
|
||||
((symbolp exp) (1- size))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue