summaryrefslogtreecommitdiff
path: root/src/cache.lisp
blob: d6bce9c32c6cf7f2cb2367c5ccc7162a5c409200 (plain)
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)