├── Makefile ├── README.md ├── UNLICENSE ├── memoize-test.el └── memoize.el /Makefile: -------------------------------------------------------------------------------- 1 | .POSIX: 2 | .SUFFIXES: .el .elc 3 | EMACS = emacs 4 | 5 | test: memoize.elc memoize-test.elc 6 | $(EMACS) -Q -batch -L . -l memoize-test.el -f ert-run-tests-batch 7 | 8 | compile: memoize.elc memoize-test.elc 9 | 10 | clean: 11 | rm -f memoize.elc memoize-test.elc 12 | 13 | memoize.elc: memoize.el 14 | memoize-test.elc: memoize-test.el 15 | 16 | .el.elc: 17 | $(EMACS) -Q -batch -L . -f batch-byte-compile $< 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Elisp memoization functions 2 | 3 | See the header in the source file for details. It's very easy to use: 4 | 5 | ```cl 6 | (require 'memoize) 7 | 8 | (memoize 'my-function) 9 | ``` 10 | 11 | The macro `defmemoize` is also provided to directly create memoized 12 | functions: 13 | 14 | ```cl 15 | (defmemoize my-expensive-function (n) 16 | (if (zerop n) 17 | 1 18 | (* n (my-expensive-function (1- n))))) 19 | ``` 20 | 21 | Some functions are run over buffer contents, and need to be cached 22 | only so long as the buffer contents do not change. For these 23 | use-cases, we have the function `memoize-by-buffer-contents` as well 24 | as the `defmemoize-by-buffer-contents` macro. 25 | 26 | To restore the original definition of a memoized function symbol (not 27 | a lambda or closure), use `memoize-restore`: 28 | 29 | ```cl 30 | (memoize 'my-function) 31 | (memoize-restore 'my-function) 32 | ``` 33 | -------------------------------------------------------------------------------- /UNLICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /memoize-test.el: -------------------------------------------------------------------------------- 1 | ;;; Tests for memoize.el -*- lexical-binding: t; -*- 2 | 3 | (require 'ert) 4 | (require 'cl-lib) 5 | (require 'memoize) 6 | 7 | (defvar memoize-numcalls 0) 8 | 9 | (defun memoize-testfunc1 (_) 10 | (cl-incf memoize-numcalls)) 11 | 12 | (ert-deftest memoize () 13 | ;; Have to defun each time since we don't want to keep re-memoizing 14 | ;; the same function. 15 | 16 | (setq memoize-numcalls 0) 17 | (let ((run-at-time-timeout) 18 | (run-at-time-func) 19 | (timer-canceled)) 20 | (cl-letf (((symbol-function 'run-at-time) 21 | (lambda (timeout repeat func) 22 | (setq run-at-time-timeout timeout) 23 | (should (null repeat)) 24 | (setq run-at-time-func func))) 25 | ((symbol-function 'cancel-timer) 26 | (lambda (_) 27 | (setq timer-canceled t)))) 28 | (memoize #'memoize-testfunc1 "10 seconds") 29 | (should (eq 0 memoize-numcalls)) 30 | (memoize-testfunc1 1) 31 | (should run-at-time-func) 32 | (should (eq 1 memoize-numcalls)) 33 | ;; Timer should be called now 34 | (should (equal "10 seconds" run-at-time-timeout)) 35 | (memoize-testfunc1 1) 36 | ;; This should be cached 37 | (should (eq 1 memoize-numcalls)) 38 | (funcall run-at-time-func) 39 | ;; Now the cache should be gone 40 | (memoize-testfunc1 1) 41 | (message "Finished running memoize-testfunc1") 42 | (should (eq 2 memoize-numcalls)) 43 | ;; Another arg is another call 44 | (memoize-testfunc1 2) 45 | (should (eq 3 memoize-numcalls)) 46 | (should timer-canceled)))) 47 | 48 | (defun memoize-testfunc2 (_a _b) 49 | (cl-incf memoize-numcalls)) 50 | 51 | (ert-deftest memoize-by-buffer-contents () 52 | (let ((f (memoize-by-buffer-contents--wrap #'memoize-testfunc2))) 53 | (setq memoize-numcalls 0) 54 | (with-temp-buffer 55 | (funcall f 0 0) 56 | (should (eq 1 memoize-numcalls)) 57 | (funcall f 0 1) 58 | (should (eq 2 memoize-numcalls)) 59 | (funcall f 0 0) 60 | (should (eq 2 memoize-numcalls)) 61 | (insert "hello world") 62 | (funcall f 0 0) 63 | (should (eq 3 memoize-numcalls))))) 64 | -------------------------------------------------------------------------------- /memoize.el: -------------------------------------------------------------------------------- 1 | ;;; memoize.el --- Memoization functions -*- lexical-binding: t; -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Christopher Wellons 6 | ;; URL: https://github.com/skeeto/emacs-memoize 7 | ;; Version: 1.1 8 | 9 | ;;; Commentary: 10 | 11 | ;; `memoize' accepts a symbol or a function. When given a symbol, the 12 | ;; symbol's function definition is memoized and installed overtop of 13 | ;; the original function definition. When given a function, it returns 14 | ;; a memoized version of that function. 15 | 16 | ;; (memoize 'my-expensive-function) 17 | 18 | ;; `defmemoize' defines a memoized function directly, behaving just 19 | ;; like `defun'. 20 | 21 | ;; (defmemoize my-expensive-function (n) 22 | ;; (if (zerop n) 23 | ;; 1 24 | ;; (* n (my-expensive-function (1- n))))) 25 | 26 | ;; Memoizing an interactive function will render that function 27 | ;; non-interactive. It would be easy to fix this problem when it comes 28 | ;; to non-byte-compiled functions, but recovering the interactive 29 | ;; definition from a byte-compiled function is more complex than I 30 | ;; care to deal with. Besides, interactive functions are always used 31 | ;; for their side effects anyway. 32 | 33 | ;; There's no way to memoize nil returns, but why would your expensive 34 | ;; functions do all that work just to return nil? :-) 35 | 36 | ;; Memoization takes up memory, which should be freed at some point. 37 | ;; Because of this, all memoization has a timeout from when the last 38 | ;; access was. The default timeout is set by 39 | ;; `memoize-default-timeout'. It can be overridden by using the 40 | ;; `memoize' function, but the `defmemoize' macro will always just use 41 | ;; the default timeout. 42 | 43 | ;; If you wait to byte-compile the function until *after* it is 44 | ;; memoized then the function and memoization wrapper both get 45 | ;; compiled at once, so there's no special reason to do them 46 | ;; separately. But there really isn't much advantage to compiling the 47 | ;; memoization wrapper anyway. 48 | 49 | ;;; Code: 50 | 51 | (require 'cl-lib) 52 | 53 | (defvar memoize-default-timeout "2 hours" 54 | "The amount of time after which to remove a memoization. 55 | This represents the time after last use of the memoization after 56 | which the value is expired. Setting this to nil means to never 57 | expire, which will cause a memory leak, but may be acceptable for 58 | very careful uses.") 59 | 60 | (defun memoize (func &optional timeout) 61 | "Memoize FUNC: a closure, lambda, or symbol. 62 | 63 | If argument is a symbol then install the memoized function over 64 | the original function. The TIMEOUT value, a timeout string as 65 | used by `run-at-time' will determine when the value expires, and 66 | will apply after the last access (unless another access 67 | happens)." 68 | (cl-typecase func 69 | (symbol 70 | (when (get func :memoize-original-function) 71 | (user-error "%s is already memoized" func)) 72 | (put func :memoize-original-documentation (documentation func)) 73 | (put func 'function-documentation 74 | (concat (documentation func) " (memoized)")) 75 | (put func :memoize-original-function (symbol-function func)) 76 | (fset func (memoize--wrap (symbol-function func) timeout)) 77 | func) 78 | (function (memoize--wrap func timeout)))) 79 | 80 | (defun memoize-restore (func) 81 | "Restore the original, non-memoized definition of FUNC. 82 | FUNC should be a symbol which has been memoized with `memoize'." 83 | (unless (get func :memoize-original-function) 84 | (user-error "%s is not memoized" func)) 85 | (fset func (get func :memoize-original-function)) 86 | (put func :memoize-original-function nil) 87 | (put func 'function-documentation 88 | (get func :memoize-original-documentation)) 89 | (put func :memoize-original-documentation nil)) 90 | 91 | (defun memoize--wrap (func timeout) 92 | "Return the memoized version of FUNC. 93 | TIMEOUT specifies how long the values last from last access. A 94 | nil timeout will cause the values to never expire, which will 95 | cause a memory leak as memoize is use, so use the nil value with 96 | care." 97 | (let ((table (make-hash-table :test 'equal)) 98 | (timeouts (make-hash-table :test 'equal))) 99 | (lambda (&rest args) 100 | (let ((value (gethash args table))) 101 | (unwind-protect 102 | (or value (puthash args (apply func args) table)) 103 | (let ((existing-timer (gethash args timeouts)) 104 | (timeout-to-use (or timeout memoize-default-timeout))) 105 | (when existing-timer 106 | (cancel-timer existing-timer)) 107 | (when timeout-to-use 108 | (puthash args 109 | (run-at-time timeout-to-use nil 110 | (lambda () 111 | (remhash args table))) timeouts)))))))) 112 | 113 | (defmacro defmemoize (name arglist &rest body) 114 | "Create a memoize'd function. NAME, ARGLIST, DOCSTRING and BODY 115 | have the same meaning as in `defun'." 116 | (declare (indent 2) (doc-string 3) (debug defun)) 117 | `(progn 118 | (defun ,name ,arglist 119 | ,@body) 120 | (memoize (quote ,name)))) 121 | 122 | (defun memoize-by-buffer-contents (func) 123 | "Memoize the given function by buffer contents. 124 | If argument is a symbol then install the memoized function over 125 | the original function." 126 | (cl-typecase func 127 | (symbol 128 | (put func 'function-documentation 129 | (concat (documentation func) " (memoized by buffer contents)")) 130 | (fset func (memoize-by-buffer-contents--wrap (symbol-function func))) 131 | func) 132 | (function (memoize-by-buffer-contents--wrap func)))) 133 | 134 | (defun memoize-by-buffer-contents--wrap (func) 135 | "Return the memoization based on the buffer contents of FUNC. 136 | 137 | This form of memoization will be based off the current buffer 138 | contents. A different memoization is stored for all buffer 139 | contents, although old contents and no-longer-existant buffers 140 | will get garbage collected." 141 | ;; We need 3 tables here to properly garbage collect. First is the 142 | ;; table for the memoization itself, `memoization-table'. It holds a 143 | ;; cons of the content hash and the function arguments. 144 | ;; 145 | ;; Buffer contents change often, though, so we want these entries to 146 | ;; be automatically garbage collected when the buffer changes or the 147 | ;; buffer goes away. To keep the entries around, we need to tie the 148 | ;; content hash to the buffer, so that the content hash string 149 | ;; doesn't go away until the buffer does. We do that with the 150 | ;; `buffer-to-contents-table'. 151 | ;; 152 | ;; But even if the buffer content does change, we need to expire the 153 | ;; memoization entries for that particular buffer content. So we 154 | ;; have a `contents-to-memoization-table' that we use to tie the 155 | ;; content hash to the memoization conses used as keys in the 156 | ;; `memoization-table'. 157 | ;; 158 | ;; If a buffer's value changes, we make sure the next time we put a 159 | ;; new value at the `buffer-to-contents-table', which causes the 160 | ;; hash string to disappear. This causes the hash-string to 161 | ;; disappear from the `contents-to-memoization-table', which causes 162 | ;; the memoizations based on that content string to disappear from 163 | ;; the `memoization-table'. 164 | (let ((memoization-table (make-hash-table :test 'equal :weakness 'key)) 165 | (buffer-to-contents-table (make-hash-table :weakness 'key)) 166 | (contents-to-memoization-table (make-hash-table :weakness 'key))) 167 | (lambda (&rest args) 168 | (let* ((bufhash (secure-hash 'md5 (buffer-string))) 169 | (memokey (cons bufhash args)) 170 | (value (gethash memokey memoization-table))) 171 | (or value 172 | (progn 173 | (puthash (current-buffer) bufhash buffer-to-contents-table) 174 | (puthash bufhash memokey contents-to-memoization-table) 175 | (puthash memokey (apply func args) memoization-table))))))) 176 | 177 | (defmacro defmemoize-by-buffer-contents (name arglist &rest body) 178 | "Create a memoize'd-by-buffer-contents function. NAME, ARGLIST, 179 | DOCSTRING and BODY have the same meaning as in `defun'." 180 | (declare (indent defun)) 181 | `(progn 182 | (defun ,name ,arglist 183 | ,@body) 184 | (memoize-by-buffer-contents (quote ,name)))) 185 | 186 | (provide 'memoize) 187 | 188 | ;;; memoize.el ends here 189 | --------------------------------------------------------------------------------