From 0d3635536d4ed8ada6946e98e7d9f03fa443bc36 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Jan 2021 14:12:50 -0500 Subject: [PATCH] * lisp/emacs-lisp/subr-x.el (named-let): New macro --- etc/NEWS | 12 +++++++----- lisp/emacs-lisp/subr-x.el | 22 ++++++++++++++++++++++ 2 files changed, 29 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index c8cbce1882a..59b13998cfa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1554,6 +1554,13 @@ buttons in it. This function takes a string and returns a string propertized in a way that makes it a valid button. +** subr-x ++++ +*** A number of new string manipulation functions have been added. +'string-clean-whitespace', 'string-fill', 'string-limit', +'string-lines', 'string-pad' and 'string-chop-newline'. + +*** New macro `named-let` that provides Scheme's "named let" looping construct ** Miscellaneous @@ -1593,11 +1600,6 @@ length to a number). *** New user option 'authinfo-hide-elements'. This can be set to nil to inhibit hiding passwords in ".authinfo" files. -+++ -*** A number of new string manipulation functions have been added. -'string-clean-whitespace', 'string-fill', 'string-limit', -'string-lines', 'string-pad' and 'string-chop-newline'. - +++ *** New variable 'current-minibuffer-command'. This is like 'this-command', but it is bound recursively when entering diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index b90227da42f..a4514454c0b 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -389,6 +389,28 @@ it makes no sense to convert it to a string using (set-buffer source-buffer) (replace-buffer-contents tmp-buffer max-secs max-costs))))))))) +(defmacro named-let (name bindings &rest body) + "Looping construct taken from Scheme. +Like `let', bind variables in BINDINGS and then evaluate BODY, +but with the twist that BODY can evaluate itself recursively by +calling NAME, where the arguments passed to NAME are used +as the new values of the bound variables in the recursive invocation." + (declare (indent 2) (debug (symbolp (&rest (symbolp form)) body))) + (require 'cl-lib) + (let ((fargs (mapcar (lambda (b) (if (consp b) (car b) b)) bindings)) + (aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings))) + ;; According to the Scheme semantics of named let, `name' is not in scope + ;; while evaluating the expressions in `bindings', and for this reason, the + ;; "initial" function call below needs to be outside of the `cl-labels'. + ;; When the "self-tco" eliminates all recursive calls, the `cl-labels' + ;; expands to a lambda which the byte-compiler then combines with the + ;; funcall to make a `let' so we end up with a plain `while' loop and no + ;; remaining `lambda' at all. + `(funcall + (cl-labels ((,name ,fargs . ,body)) #',name) + . ,aargs))) + + (provide 'subr-x) ;;; subr-x.el ends here -- 2.39.2