>From ca7f5a62e2bda9ee5e8d9199ae80714674e18511 Mon Sep 17 00:00:00 2001
From: Michael Heerdegen <address@hidden>
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.
* 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                             |  3 +++
 lisp/emacs-lisp/subr-x.el            | 49 +++++++++++++++++++++++++++++++++++
 test/lisp/emacs-lisp/subr-x-tests.el | 50 +++++++++++++++++++++++++++++++++++-
 3 files changed, 101 insertions(+), 1 deletion(-)

diff --git a/etc/NEWS b/etc/NEWS
index c47ca42d27..451688c665 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -128,6 +128,9 @@ 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..ea22bee13f 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -245,6 +245,55 @@ string-remove-suffix
       (substring string 0 (- (length string) (length suffix)))
     string))
 
+(defmacro lazy-let (bindings &rest body)
+  "Like `let' but create lazy bindings.
+
+BINDINGS is a list of elements of the form (SYMBOL EXPRESSION).
+Any binding EXPRESSION is not evaluated before the variable
+SYMBOL 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
+          (`(,(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)
+  `(progn
+     (eval-and-compile (require 'thunk))
+     (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 create lazy bindings.
+
+BINDINGS is a list of elements of the form (SYMBOL EXPRESSION).
+Any binding EXPRESSION is not evaluated before the variable
+SYMBOL 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 (macroexp-progn body)))
+
 (provide 'subr-x)
 
 ;;; subr-x.el ends here
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