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 sequences ;
   4 IN: cache
   5
   6 TUPLE: cache-assoc assoc max-age disposed ;
   7
   8 : <cache-assoc> ( -- cache )
   9     H{ } clone 10 f cache-assoc boa ;
  10
  11 <PRIVATE
  12
  13 TUPLE: cache-entry value age ;
  14
  15 : <cache-entry> ( value -- entry ) 0 cache-entry boa ; inline
  16
  17 M: cache-entry dispose value>> dispose ;
  18
  19 M: cache-assoc assoc-size assoc>> assoc-size ;
  20
  21 M: cache-assoc at* assoc>> at* [ dup [ 0 >>age value>> ] when ] dip ;
  22
  23 M: cache-assoc set-at
  24     [ check-disposed ] keep
  25     [ <cache-entry> ] 2dip
  26     assoc>> set-at ;
  27
  28 M: cache-assoc clear-assoc assoc>> clear-assoc ;
  29
  30 M: cache-assoc >alist assoc>> [ value>> ] { } assoc-map-as ;
  31
  32 INSTANCE: cache-assoc assoc
  33
  34 M: cache-assoc dispose*
  35     [ values dispose-each ] [ clear-assoc ] bi ;
  36
  37 PRIVATE>
  38
  39 : purge-cache ( cache -- )
  40     dup max-age>> '[
  41         [ nip [ 1 + ] change-age age>> _ >= ] assoc-partition
  42         [ values dispose-each ] dip
  43     ] change-assoc drop ;