lru-cache: adding fifo-cache.

diff --git a/extra/lru-cache/lru-cache-tests.factor b/extra/lru-cache/lru-cache-tests.factor
index 3f60a3c75ccd7ae6995c09f0add160acccd5217b..d3bcc9eedf21651fe2d0e1b4366f01cb42e3e569 100644 (file)
--- a/extra/lru-cache/lru-cache-tests.factor
+++ b/extra/lru-cache/lru-cache-tests.factor
@@ -39,3 +39,28 @@ USING: assocs kernel lru-cache sorting tools.test ;
     5 5 pick set-at
     >alist natural-sort
 ] unit-test
+
+{
+    { { 3 3 } { 4 4 } { 5 5 } }
+} [
+    3 <fifo-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 <fifo-hash>
+    1 1 pick set-at
+    2 2 pick set-at
+    3 3 pick set-at
+    1 1 pick set-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 ce2b7466da69dda25a101b40c17deee99a25a3d0..e9bb8fc3c72528433f59c29bd687c12af70a7699 100644 (file)
--- a/extra/lru-cache/lru-cache.factor
+++ b/extra/lru-cache/lru-cache.factor
@@ -35,3 +35,24 @@ M: lru-cache set-at
 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 )
+    dupd new-assoc <dlist> rot fifo-cache boa ;
+
+: <fifo-hash> ( max-size -- assoc )
+    H{ } <fifo-cache> ;
+
+M: fifo-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* ;
+
+M: fifo-cache clone
+    [ assoc>> clone ] [ dlist>> clone ] [ max-size>> ] tri
+    fifo-cache boa ;