basis/linked-sets/linked-sets.factor

   1 ! Copyright (C) 2016 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs deques dlists fry hashtables
   4 kernel linked-assocs sets ;
   5 IN: linked-sets
   6
   7 TUPLE: linked-set { assoc hashtable read-only } { dlist dlist read-only } ;
   8
   9 : <linked-set> ( capacity -- linked-set )
  10     <hashtable> <dlist> linked-set boa ;
  11
  12 M: linked-set in? assoc>> key? ;
  13
  14 M: linked-set clear-set
  15     [ assoc>> clear-assoc ] [ dlist>> clear-deque ] bi ;
  16
  17 <PRIVATE
  18
  19 : (delete-at) ( key assoc dlist -- )
  20     '[ at [ _ delete-node ] when* ] [ delete-at ] 2bi ; inline
  21
  22 PRIVATE>
  23
  24 M: linked-set delete
  25     [ assoc>> ] [ dlist>> ] bi (delete-at) ;
  26
  27 M: linked-set cardinality assoc>> assoc-size ;
  28
  29 M: linked-set adjoin
  30     [ assoc>> ] [ dlist>> ] bi
  31     '[ _ 2over key? [ 3dup (delete-at) ] when nip push-back* ]
  32     [ set-at ] 2bi ;
  33
  34 M: linked-set members
  35     dlist>> dlist>sequence ;
  36
  37 M: linked-set clone
  38     [ assoc>> clone ] [ dlist>> clone ] bi linked-set boa ;
  39
  40 M: linked-set equal?
  41     over linked-set? [ [ dlist>> ] bi@ = ] [ 2drop f ] if ;
  42
  43 : >linked-set ( set -- linked-set )
  44     [ 0 <linked-set> ] dip union! ;
  45
  46 INSTANCE: linked-set set
  47
  48 M: linked-set set-like
  49     drop dup linked-set? [ >linked-set ] unless ;