Initial commit.

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)