feat(lib): extend function deftypes in letf! macro
This adds support for two new definition types to the left! convenience macro: defun* and defadvice. First, defun* is for defining recursive, local functions (uses cl-labels under the hood). e.g. (letf! (defun* triangle (number) (cond ((<= number 0) 0) ((= number 1) 1) ((> number 1) (+ number (triangle (1- number)))))) ...) Second, defadvice is for defining temporary advice (which has a global effect; it can later be improved to limit scope by redefining things with cl-letf). e.g. (letf! (defadvice my-fixed-triangle (fn number) :around #'triangle (funcall fn (1+ number))) ...)
This commit is contained in:
parent
0fe6cb33be
commit
d13816ce3e
1 changed files with 29 additions and 15 deletions
|
@ -140,33 +140,47 @@ at the values with which this function was called."
|
|||
,@body))
|
||||
|
||||
(defmacro letf! (bindings &rest body)
|
||||
"Temporarily rebind function and macros in BODY.
|
||||
Intended as a simpler version of `cl-letf' and `cl-macrolet'.
|
||||
"Temporarily rebind function, macros, and advice in BODY.
|
||||
|
||||
BINDINGS is either a) a list of, or a single, `defun' or `defmacro'-ish form, or
|
||||
b) a list of (PLACE VALUE) bindings as `cl-letf*' would accept.
|
||||
Intended as syntax sugar for `cl-letf', `cl-labels', `cl-macrolet', and
|
||||
temporary advice.
|
||||
|
||||
TYPE is either `defun' or `defmacro'. NAME is the name of the function. If an
|
||||
original definition for NAME exists, it can be accessed as a lexical variable by
|
||||
the same name, for use with `funcall' or `apply'. ARGLIST and BODY are as in
|
||||
`defun'.
|
||||
BINDINGS is either:
|
||||
|
||||
A list of, or a single, `defun', `defun*', `defmacro', or `defadvice' forms.
|
||||
A list of (PLACE VALUE) bindings as `cl-letf*' would accept.
|
||||
|
||||
TYPE is one of:
|
||||
|
||||
`defun' (uses `cl-letf')
|
||||
`defun*' (uses `cl-labels'; allows recursive references),
|
||||
`defmacro' (uses `cl-macrolet')
|
||||
`defadvice' (uses `defadvice!' before BODY, then `undefadvice!' after)
|
||||
|
||||
NAME, ARGLIST, and BODY are the same as `defun', `defun*', `defmacro', and
|
||||
`defadvice!', respectively.
|
||||
|
||||
\(fn ((TYPE NAME ARGLIST &rest BODY) ...) BODY...)"
|
||||
(declare (indent defun))
|
||||
(setq body (macroexp-progn body))
|
||||
(when (memq (car bindings) '(defun defmacro))
|
||||
(when (memq (car bindings) '(defun defun* defmacro defadvice))
|
||||
(setq bindings (list bindings)))
|
||||
(dolist (binding (reverse bindings) (macroexpand body))
|
||||
(dolist (binding (reverse bindings) body)
|
||||
(let ((type (car binding))
|
||||
(rest (cdr binding)))
|
||||
(setq
|
||||
body (pcase type
|
||||
(`defmacro `(cl-macrolet ((,@rest)) ,body))
|
||||
(`defun `(cl-letf* ((,(car rest) (symbol-function #',(car rest)))
|
||||
((symbol-function #',(car rest))
|
||||
(lambda ,(cadr rest) ,@(cddr rest))))
|
||||
(ignore ,(car rest))
|
||||
,body))
|
||||
(`defadvice `(progn (defadvice! ,@rest)
|
||||
(unwind-protect ,body (undefadvice! ,@rest))))
|
||||
((or `defun `defun*)
|
||||
`(cl-letf ((,(car rest) (symbol-function #',(car rest))))
|
||||
(ignore ,(car rest))
|
||||
,(if (eq type 'defun*)
|
||||
`(cl-labels ((,@rest)) ,body)
|
||||
`(cl-letf (((symbol-function #',(car rest))
|
||||
(fn! ,(cadr rest) ,@(cddr rest))))
|
||||
,body))))
|
||||
(_
|
||||
(when (eq (car-safe type) 'function)
|
||||
(setq type (list 'symbol-function type)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue