emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Fix letf! sometimes losing letf binds

Browse source 
When expanding:

  (quiet! ...)

You'd expect (simplified for explanation):

  (letf! ((standard-output ...)
         ((symbol-function #'message) ...)
         ((symbol-function #'load-file) ...)
         ((symbol-function #'write-region) ...))
    ...)

But instead get:

  (letf! ((standard-output ...))
    ;; where'd the other binds go?
    ...)

This was due to data-loss caused by nreverse's destructive mutation of
the given bindings.

Also: silences byte-compiler complaining about unused bindings.
This commit is contained in:
Henrik Lissner 2020-05-14 22:32:03 -04:00
parent e7f04a3d87
commit 68709fe93a
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
1 changed files with 7 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

13
core/core-lib.el
View file

@ -210,20 +210,21 @@ the same name, for use with `funcall' or `apply'. ARGLIST and BODY are as in
(setq body (macroexp-progn body)) (setq body (macroexp-progn body))
(when (memq (car bindings) '(defun defmacro)) (when (memq (car bindings) '(defun defmacro))
(setq bindings (list bindings))) (setq bindings (list bindings)))
(dolist (binding (nreverse bindings) body) (dolist (binding (reverse bindings) (macroexpand body))
(let ((type (car binding)) (let ((type (car binding))
(rest (cdr binding))) (rest (cdr binding)))
(setq (setq
body (pcase type body (pcase type
(`defmacro `(cl-macrolet ((,(car rest) ,(cadr rest) ,@(cddr rest))) ,body)) (`defmacro `(cl-macrolet ((,(car rest) ,(cadr rest) ,@(cddr rest))) ,body))
(`defun `(cl-letf* ((,(car rest) (symbol-function #',(car rest))) (`defun `(cl-letf* ((,(car rest) (symbol-function #',(car rest)))
((symbol-function #',(car rest)) ((symbol-function #',(car rest))
(lambda ,(cadr rest) ,@(cddr rest)))) (lambda ,(cadr rest) ,@(cddr rest))))
,body)) (ignore ,(car rest))
,body))
(_ (_
(when (eq (car-safe type) 'function) (when (eq (car-safe type) 'function)
(setq type `(symbol-function ,type))) (setq type (list 'symbol-function type)))
`(cl-letf ((,type ,@rest)) ,body))))))) (list 'cl-letf (list (cons type rest)) body)))))))
(defmacro quiet! (&rest forms) (defmacro quiet! (&rest forms)
"Run FORMS without generating any output. "Run FORMS without generating any output.