basis/cache/cache.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel assocs math accessors destructors fry ;
   4 IN: cache
   5
   6 SLOT: age
   7
   8 GENERIC: age ( obj -- )
   9
  10 M: object age [ 1+ ] change-age drop ;
  11
  12 TUPLE: cache-assoc assoc max-age disposed ;
  13
  14 : <cache-assoc> ( -- cache )
  15     H{ } clone 10 f cache-assoc boa ;
  16
  17 M: cache-assoc assoc-size assoc>> assoc-size ;
  18
  19 M: cache-assoc at* assoc>> at* [ dup [ 0 >>age ] when ] dip ;
  20
  21 M: cache-assoc set-at dup check-disposed assoc>> set-at ;
  22
  23 M: cache-assoc clear-assoc assoc>> clear-assoc ;
  24
  25 M: cache-assoc >alist assoc>> >alist ;
  26
  27 INSTANCE: cache-assoc assoc
  28
  29 : purge-cache ( cache -- )
  30     dup max-age>> '[
  31         [ nip dup age age>> _ >= ] assoc-partition
  32         [ values dispose-each ] dip
  33     ] change-assoc drop ;
  34
  35 M: cache-assoc dispose*
  36     assoc>> [ values dispose-each ] [ clear-assoc ] bi ;