cache: don't require values to have an age slot anymore

diff --git a/basis/cache/cache.factor b/basis/cache/cache.factor
index 07bad27b2ed8b89a9bd7978288cc9c261d21320a..f16461bf450b994375afd92262db8366686a2024 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 ;
+    ] change-assoc drop ;
\ No newline at end of file

diff --git a/basis/cache/summary.txt b/basis/cache/summary.txt
new file mode 100644 (file)
index 0000000..2382bfd
--- /dev/null
+++ b/basis/cache/summary.txt
@@ -0,0 +1 @@
+An associative mapping whose entries expire after a while

diff --git a/basis/cache/tags.txt b/basis/cache/tags.txt
new file mode 100644 (file)
index 0000000..42d711b
--- /dev/null
+++ b/basis/cache/tags.txt
@@ -0,0 +1 @@
+collections

diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor
index 5699a04b9d333b0a73669f582ccfa196a893dce8..6cf742288eb1f4aeb754d9efedec5b91509de520 100644 (file)
--- a/basis/core-text/core-text.factor
+++ b/basis/core-text/core-text.factor
@@ -47,7 +47,7 @@ ERROR: not-a-string object ;
         CTLineCreateWithAttributedString
     ] with-destructors ;
 
-TUPLE: line font line metrics dim bitmap age disposed ;
+TUPLE: line font line metrics dim bitmap disposed ;
 
 : compute-line-metrics ( line -- line-metrics )
     0 <CGFloat> 0 <CGFloat> 0 <CGFloat>
@@ -92,9 +92,9 @@ TUPLE: line font line metrics dim bitmap age disposed ;
                     [ [ line ] dip CTLineDraw ]
                 } cleave
             ] with-bitmap-context
-            [ open-font line metrics dim ] dip 0 f
+            [ open-font line metrics dim ] dip
         ]
-        line boa
+        f line boa
     ] with-destructors ;
 
 M: line dispose* [ font>> CFRelease ] [ line>> CFRelease ] bi ;

diff --git a/basis/opengl/texture-cache/texture-cache.factor b/basis/opengl/texture-cache/texture-cache.factor
index ab9f8c7244986e09c6707c670d0388635bd82246..19b4044f284c65f045a5c985d6eb77000c34450c 100644 (file)
--- a/basis/opengl/texture-cache/texture-cache.factor
+++ b/basis/opengl/texture-cache/texture-cache.factor
@@ -4,7 +4,7 @@ USING: accessors assocs cache colors.constants destructors fry
 kernel opengl opengl.gl combinators ;
 IN: opengl.texture-cache
 
-TUPLE: texture texture display-list age disposed ;
+TUPLE: texture texture display-list disposed ;
 
 : make-texture-display-list ( dim texture -- dlist )
     GL_COMPILE [
@@ -30,7 +30,7 @@ C: <texture-info> texture-info
         { [ dim>> ] [ bitmap>> ] [ format>> ] [ type>> ] }
         cleave make-texture
     ] [ dim>> ] bi
-    over make-texture-display-list 0 f texture boa ;
+    over make-texture-display-list f texture boa ;
 
 M: texture dispose*
     [ texture>> delete-texture ]