1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
;;; memoize.el --- Memoization functions -*- lexical-binding: t; -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <mosquitopsu@gmail.com>
;; URL: https://github.com/skeeto/emacs-memoize
;; Package-Version: 20180614.1230
;; Version: 1.1
;;; Commentary:
;; `memoize' accepts a symbol or a function. When given a symbol, the
;; symbol's function definition is memoized and installed overtop of
;; the original function definition. When given a function, it returns
;; a memoized version of that function.
;; (memoize 'my-expensive-function)
;; `defmemoize' defines a memoized function directly, behaving just
;; like `defun'.
;; (defmemoize my-expensive-function (x)
;; (if (zerop n)
;; 1
;; (* n (my-expensive-function (1- n)))))
;; Memoizing an interactive function will render that function
;; non-interactive. It would be easy to fix this problem when it comes
;; to non-byte-compiled functions, but recovering the interactive
;; definition from a byte-compiled function is more complex than I
;; care to deal with. Besides, interactive functions are always used
;; for their side effects anyway.
;; There's no way to memoize nil returns, but why would your expensive
;; functions do all that work just to return nil? :-)
;; Memoization takes up memory, which should be freed at some point.
;; Because of this, all memoization has a timeout from when the last
;; access was. The default timeout is set by
;; `memoize-default-timeout'. It can be overriden by using the
;; `memoize' function, but the `defmemoize' macro will always just use
;; the default timeout.
;; If you wait to byte-compile the function until *after* it is
;; memoized then the function and memoization wrapper both get
;; compiled at once, so there's no special reason to do them
;; separately. But there really isn't much advantage to compiling the
;; memoization wrapper anyway.
;;; Code:
(require 'cl-lib)
(defvar memoize-default-timeout "2 hours"
"The amount of time after which to remove a memoization.
This represents the time after last use of the memoization after
which the value is expired. Setting this to nil means to never
expire, which will cause a memory leak, but may be acceptable for
very careful uses.")
(defun memoize (func &optional timeout)
"Memoize FUNC: a closure, lambda, or symbol.
If argument is a symbol then install the memoized function over
the original function. The TIMEOUT value, a timeout string as
used by `run-at-time' will determine when the value expires, and
will apply after the last access (unless another access
happens)."
(cl-typecase func
(symbol
(when (get func :memoize-original-function)
(user-error "%s is already memoized" func))
(put func :memoize-original-documentation (documentation func))
(put func 'function-documentation
(concat (documentation func) " (memoized)"))
(put func :memoize-original-function (symbol-function func))
(fset func (memoize--wrap (symbol-function func) timeout))
func)
(function (memoize--wrap func timeout))))
(defun memoize-restore (func)
"Restore the original, non-memoized definition of FUNC.
FUNC should be a symbol which has been memoized with `memoize'."
(unless (get func :memoize-original-function)
(user-error "%s is not memoized" func))
(fset func (get func :memoize-original-function))
(put func :memoize-original-function nil)
(put func 'function-documentation
(get func :memoize-original-documentation))
(put func :memoize-original-documentation nil))
(defun memoize--wrap (func timeout)
"Return the memoized version of FUNC.
TIMEOUT specifies how long the values last from last access. A
nil timeout will cause the values to never expire, which will
cause a memory leak as memoize is use, so use the nil value with
care."
(let ((table (make-hash-table :test 'equal))
(timeouts (make-hash-table :test 'equal)))
(lambda (&rest args)
(let ((value (gethash args table)))
(unwind-protect
(or value (puthash args (apply func args) table))
(let ((existing-timer (gethash args timeouts))
(timeout-to-use (or timeout memoize-default-timeout)))
(when existing-timer
(cancel-timer existing-timer))
(when timeout-to-use
(puthash args
(run-at-time timeout-to-use nil
(lambda ()
(remhash args table))) timeouts))))))))
(defmacro defmemoize (name arglist &rest body)
"Create a memoize'd function. NAME, ARGLIST, DOCSTRING and BODY
have the same meaning as in `defun'."
(declare (indent defun))
`(progn
(defun ,name ,arglist
,@body)
(memoize (quote ,name))))
(defun memoize-by-buffer-contents (func)
"Memoize the given function by buffer contents.
If argument is a symbol then install the memoized function over
the original function."
(cl-typecase func
(symbol
(put func 'function-documentation
(concat (documentation func) " (memoized by buffer contents)"))
(fset func (memoize-by-buffer-contents--wrap (symbol-function func)))
func)
(function (memoize-by-buffer-contents--wrap func))))
(defun memoize-by-buffer-contents--wrap (func)
"Return the memoization based on the buffer contents of FUNC.
This form of memoization will be based off the current buffer
contents. A different memoization is stored for all buffer
contents, although old contents and no-longer-existant buffers
will get garbage collected."
;; We need 3 tables here to properly garbage collect. First is the
;; table for the memoization itself, `memoization-table'. It holds a
;; cons of the content hash and the function arguments.
;;
;; Buffer contents change often, though, so we want these entries to
;; be automatically garbage collected when the buffer changes or the
;; buffer goes away. To keep the entries around, we need to tie the
;; content hash to the buffer, so that the content hash string
;; doesn't go away until the buffer does. We do that with the
;; `buffer-to-contents-table'.
;;
;; But even if the buffer content does change, we need to expire the
;; memoization entries for that particular buffer content. So we
;; have a `contents-to-memoization-table' that we use to tie the
;; content hash to the memoization conses used as keys in the
;; `memoization-table'.
;;
;; If a buffer's value changes, we make sure the next time we put a
;; new value at the `buffer-to-contents-table', which causes the
;; hash string to disappear. This causes the hash-string to
;; disappear from the `contents-to-memoization-table', which causes
;; the memoizations based on that content string to disappear from
;; the `memoization-table'.
(let ((memoization-table (make-hash-table :test 'equal :weakness 'key))
(buffer-to-contents-table (make-hash-table :weakness 'key))
(contents-to-memoization-table (make-hash-table :weakness 'key)))
(lambda (&rest args)
(let* ((bufhash (secure-hash 'md5 (buffer-string)))
(memokey (cons bufhash args))
(value (gethash memokey memoization-table)))
(or value
(progn
(puthash (current-buffer) bufhash buffer-to-contents-table)
(puthash bufhash memokey contents-to-memoization-table)
(puthash memokey (apply func args) memoization-table)))))))
(defmacro defmemoize-by-buffer-contents (name arglist &rest body)
"Create a memoize'd-by-buffer-contents function. NAME, ARGLIST,
DOCSTRING and BODY have the same meaning as in `defun'."
(declare (indent defun))
`(progn
(defun ,name ,arglist
,@body)
(memoize-by-buffer-contents (quote ,name))))
(provide 'memoize)
;;; memoize.el ends here
|
