extra/lru-cache/lru-cache.factor

   1 ! Copyright (C) 2017 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors assocs deques dlists fry kernel linked-assocs
   5 linked-assocs.private math sequences.private ;
   6
   7 IN: lru-cache
   8
   9 TUPLE: lru-cache < linked-assoc max-size ;
  10
  11 : <lru-cache> ( max-size exemplar -- assoc )
  12     0 swap new-assoc <dlist> rot lru-cache boa ;
  13
  14 : <lru-hash> ( max-size -- assoc )
  15     H{ } <lru-cache> ;
  16
  17 M: lru-cache at*
  18     [ assoc>> at* ] [ dlist>> dup ] bi '[
  19         [
  20             [ _ delete-node ]
  21             [ _ push-node-back ]
  22             [ obj>> second-unsafe ] tri
  23         ] when
  24     ] keep ;
  25
  26 M: lru-cache set-at
  27     [ call-next-method ] keep dup max-size>> [
  28         over assoc>> assoc-size < [
  29             [ dlist>> pop-front first-unsafe ]
  30             [ assoc>> ]
  31             [ dlist>> ] tri (delete-at)
  32         ] [ drop ] if
  33     ] [ drop ] if* ;
  34
  35 M: lru-cache clone
  36     [ assoc>> clone ] [ dlist>> clone ] [ max-size>> ] tri
  37     lru-cache boa ;