>From 4941becd07f6ffbe387006248193d95b258be526 Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Thu, 2 Nov 2017 18:45:34 +0100 Subject: [PATCH] Add macros `lazy-let' and `lazy-let*' * lisp/emacs-lisp/subr-x.el (lazy-let, lazy-let*): New macros. * lisp/emacs-lisp/thunk.el (thunk-delay, thunk-force): Add autoload cookies. * test/lisp/emacs-lisp/subr-x-tests.el: Use lexical-binding. (subr-x-lazy-let-basic-test, subr-x-lazy-let*-basic-test) (subr-x-lazy-let-bound-vars-cant-be-bound-test) (subr-x-lazy-let-lazyness-test, subr-x-lazy-let*-lazyness-test) (subr-x-lazy-let-bad-binding-test): New tests for `lazy-let' and `lazy-let*. --- etc/NEWS | 4 +++ lisp/emacs-lisp/subr-x.el | 48 ++++++++++++++++++++++++++++++++++ lisp/emacs-lisp/thunk.el | 2 ++ test/lisp/emacs-lisp/subr-x-tests.el | 50 +++++++++++++++++++++++++++++++++++- 4 files changed, 103 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index c47ca42d27..8b1f659ebf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -128,6 +128,10 @@ calling 'eldoc-message' directly. * Lisp Changes in Emacs 27.1 +--- +** The new macros 'lazy-let' and 'lazy-let*' are analogue to `let' and +`let*' but create bindings that are evaluated lazily. + --- ** The 'file-system-info' function is now available on all platforms. instead of just Microsoft platforms. This fixes a 'get-free-disk-space' diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 8ed29d8659..ce8956c96f 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -245,6 +245,54 @@ string-remove-suffix (substring string 0 (- (length string) (length suffix))) string)) +(defmacro lazy-let (bindings &rest body) + "Like `let' but make delayed bindings. + +This is like `let' but any binding expression is not evaluated +before the variable is used for the first time. + +It is not allowed to set `lazy-let' or `lazy-let*' bound +variables." + (declare (indent 1) (debug let)) + (cl-callf2 mapcar + (lambda (binding) + (pcase binding + ((or (and (pred symbolp) s) + `(,(and (pred symbolp) s))) + `(,s nil)) + (`(,(pred symbolp) ,_) binding) + (_ (signal 'error (cons "Bad binding in lazy-let" + (list binding)))))) + bindings) + (cl-callf2 mapcar + (pcase-lambda (`(,var ,binding)) + (list (make-symbol (concat (symbol-name var) "-thunk")) + var binding)) + bindings) + `(let ,(mapcar + (pcase-lambda (`(,thunk-var ,_var ,binding)) + `(,thunk-var (thunk-delay ,binding))) + bindings) + (cl-symbol-macrolet + ,(mapcar (pcase-lambda (`(,thunk-var ,var ,_binding)) + `(,var (thunk-force ,thunk-var))) + bindings) + ,@body))) + +(defmacro lazy-let* (bindings &rest body) + "Like `let*' but make delayed bindings. + +This is like `let*' but any binding expression is not evaluated +before the variable is used for the first time. + +It is not allowed to set `lazy-let' or `lazy-let*' bound +variables." + (declare (indent 1) (debug let)) + (cl-reduce + (lambda (expr binding) `(lazy-let (,binding) ,expr)) + (nreverse bindings) + :initial-value `(progn ,@body))) + (provide 'subr-x) ;;; subr-x.el ends here diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el index 371d10444b..0c5d0b709e 100644 --- a/lisp/emacs-lisp/thunk.el +++ b/lisp/emacs-lisp/thunk.el @@ -46,6 +46,7 @@ (eval-when-compile (require 'cl-macs)) +;;;###autoload (defmacro thunk-delay (&rest body) "Delay the evaluation of BODY." (declare (debug t)) @@ -61,6 +62,7 @@ thunk-delay (setf ,forced t)) ,val))))) +;;;###autoload (defun thunk-force (delayed) "Force the evaluation of DELAYED. The result is cached and will be returned on subsequent calls diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 0e8871d9a9..c477a63a29 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -1,4 +1,4 @@ -;;; subr-x-tests.el --- Testing the extended lisp routines +;;; subr-x-tests.el --- Testing the extended lisp routines -*- lexical-binding: t -*- ;; Copyright (C) 2014-2017 Free Software Foundation, Inc. @@ -538,6 +538,54 @@ (format "abs sum is: %s")) "abs sum is: 15"))) + +;; lazy-let tests + +(ert-deftest subr-x-lazy-let-basic-test () + "Test whether bindings are established." + (should (equal (lazy-let ((x 1) (y 2)) (+ x y)) 3))) + +(ert-deftest subr-x-lazy-let*-basic-test () + "Test whether bindings are established." + (should (equal (lazy-let* ((x 1) (y (+ 1 x))) (+ x y)) 3))) + +(ert-deftest subr-x-lazy-let-bound-vars-cant-be-bound-test () + "Test whether setting or binding a `lazy-let' bound variable fails." + (should-error (eval '(lazy-let ((x 1)) (let ((y 7)) (setq x (+ x y)) (* 10 x))) t)) + (should-error (eval '(lazy-let ((x 1)) (let ((x 2)) x)) t))) + +(ert-deftest subr-x-lazy-let-lazyness-test () + "Test for lazyness." + (should + (equal (let ((x-evalled nil) + (y-evalled nil)) + (lazy-let ((x (progn (setq x-evalled t) (+ 1 2))) + (y (progn (setq y-evalled t) (+ 3 4)))) + (let ((evalled-y y)) + (list x-evalled y-evalled evalled-y)))) + (list nil t 7)))) + +(ert-deftest subr-x-lazy-let*-lazyness-test () + "Test lazyness of `lazy-let*'." + (should + (equal (let ((x-evalled nil) + (y-evalled nil) + (z-evalled nil) + (a-evalled nil)) + (lazy-let* ((x (progn (setq x-evalled t) (+ 1 1))) + (y (progn (setq y-evalled t) (+ x 1))) + (z (progn (setq z-evalled t) (+ y 1))) + (a (progn (setq a-evalled t) (+ z 1)))) + (let ((evalled-z z)) + (list x-evalled y-evalled z-evalled a-evalled evalled-z)))) + (list t t t nil 4)))) + +(ert-deftest subr-x-lazy-let-bad-binding-test () + "Test whether a bad binding causes a compiler error." + (should-error (byte-compile (lazy-let ((x 1 1)) x))) + (should-error (byte-compile (lazy-let (27) x))) + (should-error (byte-compile (lazy-let x x)))) + (provide 'subr-x-tests) ;;; subr-x-tests.el ends here -- 2.14.2