lisp/emacs-lisp/thunk.el

   1 ;;; thunk.el --- Lazy form evaluation  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Petton <nicolas@petton.fr>
   6 ;; Keywords: sequences
   7 ;; Version: 1.0
   8 ;; Package: thunk
   9
  10 ;; Maintainer: emacs-devel@gnu.org
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;; Thunk provides functions and macros to delay the evaluation of
  30 ;; forms.
  31 ;;
  32 ;; Use `thunk-delay' to delay the evaluation of a form (requires
  33 ;; lexical-binding), and `thunk-force' to evaluate it. The result of
  34 ;; the evaluation is cached, and only happens once.
  35 ;;
  36 ;; Here is an example of a form which evaluation is delayed:
  37 ;;
  38 ;;     (setq delayed (thunk-delay (message "this message is delayed")))
  39 ;;
  40 ;; `delayed' is not evaluated until `thunk-force' is called, like the
  41 ;; following:
  42 ;;
  43 ;;    (thunk-force delayed)
  44 ;;
  45 ;; This file also defines macros `thunk-let' and `thunk-let*' that are
  46 ;; analogous to `let' and `let*' but provide lazy evaluation of
  47 ;; bindings by using thunks implicitly (i.e. in the expansion).
  48
  49 ;;; Code:
  50
  51 (eval-when-compile (require 'cl-macs))
  52
  53 (defmacro thunk-delay (&rest body)
  54   "Delay the evaluation of BODY."
  55   (declare (debug t))
  56   (cl-assert lexical-binding)
  57   (let ((forced (make-symbol "forced"))
  58         (val (make-symbol "val")))
  59     `(let (,forced ,val)
  60        (lambda (&optional check)
  61          (if check
  62              ,forced
  63            (unless ,forced
  64              (setf ,val (progn ,@body))
  65              (setf ,forced t))
  66            ,val)))))
  67
  68 (defun thunk-force (delayed)
  69   "Force the evaluation of DELAYED.
  70 The result is cached and will be returned on subsequent calls
  71 with the same DELAYED argument."
  72   (funcall delayed))
  73
  74 (defun thunk-evaluated-p (delayed)
  75   "Return non-nil if DELAYED has been evaluated."
  76   (funcall delayed t))
  77
  78 (defmacro thunk-let (bindings &rest body)
  79   "Like `let' but create lazy bindings.
  80
  81 BINDINGS is a list of elements of the form (SYMBOL EXPRESSION).
  82 Any binding EXPRESSION is not evaluated before the variable
  83 SYMBOL is used for the first time when evaluating the BODY.
  84
  85 It is not allowed to set `thunk-let' or `thunk-let*' bound
  86 variables.
  87
  88 Using `thunk-let' and `thunk-let*' requires `lexical-binding'."
  89   (declare (indent 1) (debug let))
  90   (cl-callf2 mapcar
  91       (lambda (binding)
  92         (pcase binding
  93           (`(,(pred symbolp) ,_) binding)
  94           (_ (signal 'error (cons "Bad binding in thunk-let"
  95                                   (list binding))))))
  96       bindings)
  97   (cl-callf2 mapcar
  98       (pcase-lambda (`(,var ,binding))
  99         (list (make-symbol (concat (symbol-name var) "-thunk"))
 100               var binding))
 101       bindings)
 102   `(let ,(mapcar
 103           (pcase-lambda (`(,thunk-var ,_var ,binding))
 104             `(,thunk-var (thunk-delay ,binding)))
 105           bindings)
 106      (cl-symbol-macrolet
 107          ,(mapcar (pcase-lambda (`(,thunk-var ,var ,_binding))
 108                     `(,var (thunk-force ,thunk-var)))
 109                   bindings)
 110        ,@body)))
 111
 112 (defmacro thunk-let* (bindings &rest body)
 113   "Like `let*' but create lazy bindings.
 114
 115 BINDINGS is a list of elements of the form (SYMBOL EXPRESSION).
 116 Any binding EXPRESSION is not evaluated before the variable
 117 SYMBOL is used for the first time when evaluating the BODY.
 118
 119 It is not allowed to set `thunk-let' or `thunk-let*' bound
 120 variables.
 121
 122 Using `thunk-let' and `thunk-let*' requires `lexical-binding'."
 123   (declare (indent 1) (debug let))
 124   (cl-reduce
 125    (lambda (expr binding) `(thunk-let (,binding) ,expr))
 126    (nreverse bindings)
 127    :initial-value (macroexp-progn body)))
 128
 129 ;; (defalias 'lazy-let  #'thunk-let)
 130 ;; (defalias 'lazy-let* #'thunk-let*)
 131
 132
 133 (provide 'thunk)
 134 ;;; thunk.el ends here