summaryrefslogtreecommitdiff
path: root/src/cache.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/cache.lisp')
-rw-r--r--src/cache.lisp45
1 files changed, 45 insertions, 0 deletions
diff --git a/src/cache.lisp b/src/cache.lisp
new file mode 100644
index 0000000..ad6a0fa
--- /dev/null
+++ b/src/cache.lisp
@@ -0,0 +1,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)