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
|
;; This is a patch for function-cache, enabling a per-stream cache for
;; eris-decode-stream.
(in-package :function-cache)
(defmacro cached-lambda (cache-list lambda-list &body body)
"Creates a cached lambda function with the cache-list
cache-list is a list (&rest CACHE-INIT-ARGS
&key CACHE-CLASS TABLE TIMEOUT SHARED-RESULTS?)
TABLE - a shared cache-store to use, usually a hash-table, a function that returns
a hashtable, or a symbol whose value is a hash-table
TIMEOUT - how long entries in the cache should be considered valid for
CACHE-CLASS - controls what cache class will be instantiated (uses
default-cache-class if not provided)
SHARED-RESULTS? - do we expect that we are sharing cache space with other things
defaults to t if TABLE is provided
CACHE-INIT-ARGS - any other args that should be passed to the cache
"
(destructuring-bind (&rest cache-args
&key table (shared-results? nil shared-result-input?)
cache-class
&allow-other-keys)
(ensure-list cache-list)
(declare (ignore cache-class)) ;; handled in default-cache-class
(remf cache-args :cache-class)
(remf cache-args :table)
(remf cache-args :shared-results?)
(when (and table (not shared-result-input?)) (setf shared-results? t))
(let* ((cache-class (default-cache-class (cons nil cache-list) lambda-list))
(call-list (%call-list-for-lambda-list lambda-list))
(cache (gensym)))
`(let ((,cache
(make-instance ',cache-class
:body-fn (lambda ,lambda-list
,@body)
:name nil
:lambda-list ',lambda-list
:shared-results? ,shared-results?
:cached-results ,table
,@cache-args)))
(lambda ,lambda-list
(cacher ,cache ,call-list))))))
(export 'cached-lambda)
|
