2009-02-10 03:45:43 -05:00
|
|
|
! Copyright (C) 2009 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-02-10 23:05:13 -05:00
|
|
|
USING: kernel assocs math accessors destructors fry sequences ;
|
2009-02-10 03:45:43 -05:00
|
|
|
IN: cache
|
|
|
|
|
2009-08-24 03:26:13 -04:00
|
|
|
TUPLE: cache-assoc < disposable assoc max-age ;
|
2009-02-10 03:45:43 -05:00
|
|
|
|
|
|
|
: <cache-assoc> ( -- cache )
|
2009-08-24 03:26:13 -04:00
|
|
|
cache-assoc new-disposable H{ } clone >>assoc 10 >>max-age ;
|
2009-02-10 03:45:43 -05:00
|
|
|
|
2009-02-10 23:05:13 -05:00
|
|
|
<PRIVATE
|
|
|
|
|
|
|
|
TUPLE: cache-entry value age ;
|
|
|
|
|
|
|
|
: <cache-entry> ( value -- entry ) 0 cache-entry boa ; inline
|
|
|
|
|
|
|
|
M: cache-entry dispose value>> dispose ;
|
|
|
|
|
2009-02-10 03:45:43 -05:00
|
|
|
M: cache-assoc assoc-size assoc>> assoc-size ;
|
|
|
|
|
2009-02-10 23:05:13 -05:00
|
|
|
M: cache-assoc at* assoc>> at* [ dup [ 0 >>age value>> ] when ] dip ;
|
2009-02-10 03:45:43 -05:00
|
|
|
|
2009-02-10 23:05:13 -05:00
|
|
|
M: cache-assoc set-at
|
|
|
|
[ check-disposed ] keep
|
|
|
|
[ <cache-entry> ] 2dip
|
|
|
|
assoc>> set-at ;
|
2009-02-10 03:45:43 -05:00
|
|
|
|
2010-10-26 00:52:45 -04:00
|
|
|
M: cache-assoc clear-assoc
|
|
|
|
[ assoc>> values dispose-each ]
|
|
|
|
[ assoc>> clear-assoc ]
|
|
|
|
bi ;
|
2009-02-10 03:45:43 -05:00
|
|
|
|
2009-02-10 23:05:13 -05:00
|
|
|
M: cache-assoc >alist assoc>> [ value>> ] { } assoc-map-as ;
|
2009-02-10 03:45:43 -05:00
|
|
|
|
|
|
|
INSTANCE: cache-assoc assoc
|
|
|
|
|
2010-10-26 00:52:45 -04:00
|
|
|
M: cache-assoc dispose* clear-assoc ;
|
2009-02-10 23:05:13 -05:00
|
|
|
|
|
|
|
PRIVATE>
|
|
|
|
|
2009-02-10 03:45:43 -05:00
|
|
|
: purge-cache ( cache -- )
|
|
|
|
dup max-age>> '[
|
2010-10-26 00:52:45 -04:00
|
|
|
[ nip [ 1 + ] change-age age>> _ < ] assoc-partition
|
|
|
|
values dispose-each
|
2009-08-13 20:21:44 -04:00
|
|
|
] change-assoc drop ;
|