From faf0158ad062d0d9716360c7cbdf0868f5381bd4 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 2 Mar 2017 16:12:01 -0800
Subject: [PATCH] lru-cache: adding a Least Recently Used (LRU) cache.

---
 extra/lru-cache/authors.txt            |  1 +
 extra/lru-cache/lru-cache-tests.factor | 41 ++++++++++++++++++++++++++
 extra/lru-cache/lru-cache.factor       | 33 +++++++++++++++++++++
 extra/lru-cache/summary.txt            |  1 +
 4 files changed, 76 insertions(+)
 create mode 100644 extra/lru-cache/authors.txt
 create mode 100644 extra/lru-cache/lru-cache-tests.factor
 create mode 100644 extra/lru-cache/lru-cache.factor
 create mode 100644 extra/lru-cache/summary.txt

diff --git a/extra/lru-cache/authors.txt b/extra/lru-cache/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/extra/lru-cache/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/lru-cache/lru-cache-tests.factor b/extra/lru-cache/lru-cache-tests.factor
new file mode 100644
index 0000000000..3f60a3c75c
--- /dev/null
+++ b/extra/lru-cache/lru-cache-tests.factor
@@ -0,0 +1,41 @@
+USING: assocs kernel lru-cache sorting tools.test ;
+
+{
+    { { 3 3 } { 4 4 } { 5 5 } }
+} [
+    3 <lru-hash>
+    1 1 pick set-at
+    2 2 pick set-at
+    3 3 pick set-at
+    4 4 pick set-at
+    5 5 pick set-at
+    >alist natural-sort
+] unit-test
+
+{
+    { { 1 1 } { 4 4 } { 5 5 } }
+} [
+    3 <lru-hash>
+    1 1 pick set-at
+    2 2 pick set-at
+    3 3 pick set-at
+    1 over at drop
+    4 4 pick set-at
+    5 5 pick set-at
+    >alist natural-sort
+] unit-test
+
+{
+    { { 2 2 } { 4 4 } { 5 5 } }
+} [
+    3 <lru-hash>
+    1 1 pick set-at
+    2 2 pick set-at
+    3 3 pick set-at
+    1 over delete-at
+    1 over at drop
+    2 over at drop
+    4 4 pick set-at
+    5 5 pick set-at
+    >alist natural-sort
+] unit-test
diff --git a/extra/lru-cache/lru-cache.factor b/extra/lru-cache/lru-cache.factor
new file mode 100644
index 0000000000..54e39c847f
--- /dev/null
+++ b/extra/lru-cache/lru-cache.factor
@@ -0,0 +1,33 @@
+! Copyright (C) 2017 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors assocs deques dlists fry kernel linked-assocs
+linked-assocs.private math sequences.private ;
+
+IN: lru-cache
+
+TUPLE: lru-cache < linked-assoc max-size ;
+
+: <lru-cache> ( max-size exemplar -- assoc )
+    0 swap new-assoc <dlist> rot lru-cache boa ;
+
+: <lru-hash> ( max-size -- assoc )
+    H{ } <lru-cache> ;
+
+M: lru-cache at*
+    [ assoc>> at* ] [ dlist>> dup ] bi '[
+        [
+            [ _ delete-node ]
+            [ _ push-node-back ]
+            [ obj>> second-unsafe ] tri
+        ] when
+    ] keep ;
+
+M: lru-cache set-at
+    [ call-next-method ] keep dup max-size>> [
+        over assoc>> assoc-size < [
+            [ dlist>> pop-front first-unsafe ]
+            [ assoc>> ]
+            [ dlist>> ] tri (delete-at)
+        ] [ drop ] if
+    ] [ drop ] if* ;
diff --git a/extra/lru-cache/summary.txt b/extra/lru-cache/summary.txt
new file mode 100644
index 0000000000..181d7e237d
--- /dev/null
+++ b/extra/lru-cache/summary.txt
@@ -0,0 +1 @@
+Least Recently Used (LRU) cache