1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs continuations destructors fry kernel
7 TUPLE: cache-assoc < disposable assoc max-age ;
9 : <cache-assoc> ( -- cache )
10 cache-assoc new-disposable H{ } clone >>assoc 10 >>max-age ;
14 TUPLE: cache-entry value age ;
16 : <cache-entry> ( value -- entry ) 0 cache-entry boa ; inline
18 M: cache-entry dispose value>> dispose ;
20 M: cache-assoc assoc-size assoc>> assoc-size ;
22 M: cache-assoc at* assoc>> at* [ dup [ 0 >>age value>> ] when ] dip ;
26 [ <cache-entry> ] 2dip
29 M: cache-assoc clear-assoc
30 assoc>> [ values dispose-each ] [ clear-assoc ] bi ;
32 M: cache-assoc >alist assoc>> [ value>> ] { } assoc-map-as ;
34 INSTANCE: cache-assoc assoc
36 M: cache-assoc dispose* clear-assoc ;
40 : purge-cache ( cache -- )
41 [ assoc>> ] [ max-age>> ] bi V{ } clone [
43 nip dup age>> 1 + [ >>age ] keep
44 _ < [ drop t ] [ _ dispose-to f ] if
46 ] keep [ last rethrow ] unless-empty ;