Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / cache / cache.factor

diff --git a/basis/cache/cache.factor b/basis/cache/cache.factor
index 07bad27b2ed8b89a9bd7978288cc9c261d21320a..3dab1acac8c8f865e5211494e2ab0978e01ad6c7 100644 (file)
--- a/basis/cache/cache.factor
+++ b/basis/cache/cache.factor
@@ -1,36 +1,43 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs math accessors destructors fry ;
+USING: kernel assocs math accessors destructors fry sequences ;
 IN: cache
 
-SLOT: age
-
-GENERIC: age ( obj -- )
-
-M: object age [ 1+ ] change-age drop ;
-
 TUPLE: cache-assoc assoc max-age disposed ;
 
 : <cache-assoc> ( -- cache )
     H{ } clone 10 f cache-assoc boa ;
 
+<PRIVATE
+
+TUPLE: cache-entry value age ;
+
+: <cache-entry> ( value -- entry ) 0 cache-entry boa ; inline
+
+M: cache-entry dispose value>> dispose ;
+
 M: cache-assoc assoc-size assoc>> assoc-size ;
 
-M: cache-assoc at* assoc>> at* [ dup [ 0 >>age ] when ] dip ;
+M: cache-assoc at* assoc>> at* [ dup [ 0 >>age value>> ] when ] dip ;
 
-M: cache-assoc set-at dup check-disposed assoc>> set-at ;
+M: cache-assoc set-at
+    [ check-disposed ] keep
+    [ <cache-entry> ] 2dip
+    assoc>> set-at ;
 
 M: cache-assoc clear-assoc assoc>> clear-assoc ;
 
-M: cache-assoc >alist assoc>> >alist ;
+M: cache-assoc >alist assoc>> [ value>> ] { } assoc-map-as ;
 
 INSTANCE: cache-assoc assoc
 
+M: cache-assoc dispose*
+    [ values dispose-each ] [ clear-assoc ] bi ;
+
+PRIVATE>
+
 : purge-cache ( cache -- )
     dup max-age>> '[
-        [ nip dup age age>> _ >= ] assoc-partition
+        [ nip [ 1 + ] change-age age>> _ >= ] assoc-partition
         [ values dispose-each ] dip
     ] change-assoc drop ;
-
-M: cache-assoc dispose*
-    assoc>> [ values dispose-each ] [ clear-assoc ] bi ;