lru-cache: adding lifo-cache.

diff --git a/extra/lru-cache/lru-cache-tests.factor b/extra/lru-cache/lru-cache-tests.factor
index d3bcc9eedf21651fe2d0e1b4366f01cb42e3e569..3516446b74a8622daba5adff30ea1e88aaaee305 100644 (file)
--- a/extra/lru-cache/lru-cache-tests.factor
+++ b/extra/lru-cache/lru-cache-tests.factor
@@ -64,3 +64,28 @@ USING: assocs kernel lru-cache sorting tools.test ;
     5 5 pick set-at
     >alist natural-sort
 ] unit-test
+
+{
+    { { 1 1 } { 2 2 } { 5 5 } }
+} [
+    3 <lifo-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
+
+{
+    { { 2 2 } { 3 3 } { 5 5 } }
+} [
+    3 <lifo-hash>
+    1 1 pick set-at
+    2 2 pick set-at
+    3 3 pick set-at
+    1 over delete-at
+    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
index e9bb8fc3c72528433f59c29bd687c12af70a7699..5fed8f33f1b6a162cd43cfaeb18e82e742b62e5d 100644 (file)
--- a/extra/lru-cache/lru-cache.factor
+++ b/extra/lru-cache/lru-cache.factor
@@ -32,10 +32,6 @@ M: lru-cache set-at
         ] [ drop ] if
     ] [ drop ] if* ;
 
-M: lru-cache clone
-    [ assoc>> clone ] [ dlist>> clone ] [ max-size>> ] tri
-    lru-cache boa ;
-
 TUPLE: fifo-cache < linked-assoc max-size ;
 
 : <fifo-cache> ( max-size exemplar -- assoc )
@@ -53,6 +49,20 @@ M: fifo-cache set-at
         ] [ drop ] if
     ] [ drop ] if* ;
 
-M: fifo-cache clone
-    [ assoc>> clone ] [ dlist>> clone ] [ max-size>> ] tri
-    fifo-cache boa ;
+TUPLE: lifo-cache < linked-assoc max-size ;
+
+: <lifo-cache> ( max-size exemplar -- assoc )
+    dupd new-assoc <dlist> rot lifo-cache boa ;
+
+: <lifo-hash> ( max-size -- assoc )
+    H{ } <lifo-cache> ;
+
+M: lifo-cache set-at
+    dup max-size>> [
+        over assoc>> assoc-size <= [
+            dup
+            [ dlist>> pop-back first-unsafe ]
+            [ assoc>> ]
+            [ dlist>> ] tri (delete-at)
+        ] when
+    ] when* call-next-method ;