basis/cache/cache.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs continuations destructors kernel math
   4 sequences ;
   5 IN: cache
   6
   7 TUPLE: cache-assoc < disposable assoc max-age ;
   8
   9 : <cache-assoc> ( -- cache )
  10     cache-assoc new-disposable H{ } clone >>assoc 10 >>max-age ;
  11
  12 <PRIVATE
  13
  14 TUPLE: cache-entry value age ;
  15
  16 : <cache-entry> ( value -- entry ) 0 cache-entry boa ; inline
  17
  18 M: cache-entry dispose value>> dispose ;
  19
  20 M: cache-assoc assoc-size assoc>> assoc-size ;
  21
  22 M: cache-assoc at* assoc>> at* [ dup [ 0 >>age value>> ] when ] dip ;
  23
  24 M: cache-assoc set-at
  25     check-disposed
  26     [ <cache-entry> ] 2dip
  27     assoc>> set-at ;
  28
  29 M: cache-assoc clear-assoc
  30     assoc>> [ values dispose-each ] [ clear-assoc ] bi ;
  31
  32 M: cache-assoc >alist assoc>> [ value>> ] { } assoc-map-as ;
  33
  34 INSTANCE: cache-assoc assoc
  35
  36 M: cache-assoc dispose* clear-assoc ;
  37
  38 PRIVATE>
  39
  40 : purge-cache ( cache -- )
  41     dup [ assoc>> ] [ max-age>> ] bi V{ } clone [
  42         '[
  43             nip dup age>> 1 + [ >>age ] keep
  44             _ < [ drop t ] [ _ dispose-to f ] if
  45         ] assoc-filter >>assoc drop
  46     ] keep [ last rethrow ] unless-empty ;