basis/linked-assocs/linked-assocs.factor

   1 ! Copyright (C) 2008 Slava Pestov, James Cash.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs arrays kernel deques dlists sequences fry ;
   4 IN: linked-assocs
   5
   6 TUPLE: linked-assoc assoc dlist ;
   7
   8 : <linked-assoc> ( exemplar -- assoc )
   9     0 swap new-assoc <dlist> linked-assoc boa ;
  10
  11 : <linked-hash> ( -- assoc )
  12     H{ } <linked-assoc> ;
  13
  14 M: linked-assoc assoc-size assoc>> assoc-size ;
  15
  16 M: linked-assoc at* assoc>> at* [ [ obj>> second ] when ] keep ;
  17
  18 M: linked-assoc delete-at
  19     [ [ assoc>> ] [ dlist>> ] bi [ at ] dip '[ _ delete-node ] when* ]
  20     [ assoc>> delete-at ] 2bi ;
  21
  22 <PRIVATE
  23 : add-to-dlist ( value key lassoc -- node )
  24     [ swap 2array ] dip dlist>> push-back* ;
  25 PRIVATE>
  26
  27 M: linked-assoc set-at
  28     [ 2dup assoc>> key? [ 2dup delete-at ] when add-to-dlist ] 2keep
  29     assoc>> set-at ;
  30
  31 M: linked-assoc >alist
  32     dlist>> dlist>seq ;
  33
  34 M: linked-assoc clear-assoc
  35     [ assoc>> clear-assoc ] [ dlist>> clear-deque ] bi ;
  36
  37 M: linked-assoc clone
  38     [ assoc>> clone ] [ dlist>> clone ] bi
  39     linked-assoc boa ;
  40
  41 INSTANCE: linked-assoc assoc