37 lines
878 B
Factor
37 lines
878 B
Factor
|
! Copyright (C) 2009 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: kernel assocs math accessors destructors fry ;
|
||
|
|
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 ;
|
||
|
|
|
||
|
|
M: cache-assoc assoc-size assoc>> assoc-size ;
|
||
|
|
|
||
|
|
M: cache-assoc at* assoc>> at* [ dup [ 0 >>age ] when ] dip ;
|
||
|
|
|
||
|
|
M: cache-assoc set-at dup check-disposed assoc>> set-at ;
|
||
|
|
|
||
|
|
M: cache-assoc clear-assoc assoc>> clear-assoc ;
|
||
|
|
|
||
|
|
M: cache-assoc >alist assoc>> >alist ;
|
||
|
|
|
||
|
|
INSTANCE: cache-assoc assoc
|
||
|
|
|
||
|
|
: purge-cache ( cache -- )
|
||
|
|
dup max-age>> '[
|
||
|
|
[ nip dup age age>> _ >= ] assoc-partition
|
||
|
|
[ values dispose-each ] dip
|
||
|
|
] change-assoc drop ;
|
||
|
|
|
||
|
|
M: cache-assoc dispose*
|
||
|
|
assoc>> [ values dispose-each ] [ clear-assoc ] bi ;
|