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:
Henrik Lissner 2021-10-01 19:07:37 +02:00
parent 0fe6cb33be
commit d13816ce3e

View file

@ -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))))
(`defadvice `(progn (defadvice! ,@rest)
(unwind-protect ,body (undefadvice! ,@rest))))
((or `defun `defun*)
`(cl-letf ((,(car rest) (symbol-function #',(car rest))))
(ignore ,(car rest))
,body))
,(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)))