basis/persistent/hashtables/nodes/nodes.factor

   1 ! Based on Clojure's PersistentHashMap by Rich Hickey.
   2
   3 USING: math arrays kernel sequences
   4 accessors locals persistent.hashtables.config ;
   5 IN: persistent.hashtables.nodes
   6
   7 SINGLETON: empty-node
   8
   9 TUPLE: leaf-node
  10 { value read-only }
  11 { key read-only }
  12 { hashcode fixnum read-only } ;
  13
  14 C: <leaf-node> leaf-node
  15
  16 TUPLE: collision-node
  17 { hashcode fixnum read-only }
  18 { leaves array read-only } ;
  19
  20 C: <collision-node> collision-node
  21
  22 TUPLE: full-node
  23 { nodes array read-only }
  24 { shift fixnum read-only }
  25 { hashcode fixnum read-only } ;
  26
  27 : <full-node> ( nodes shift -- node )
  28     over first hashcode>> full-node boa ;
  29
  30 TUPLE: bitmap-node
  31 { bitmap fixnum read-only }
  32 { nodes array read-only }
  33 { shift fixnum read-only }
  34 { hashcode fixnum read-only } ;
  35
  36 : <bitmap-node> ( bitmap nodes shift -- node )
  37     pick full-bitmap-mask =
  38     [ <full-node> nip ]
  39     [ over first hashcode>> bitmap-node boa ] if ;
  40
  41 GENERIC: (entry-at) ( key hashcode node -- entry )
  42
  43 GENERIC: (new-at) ( shift value key hashcode node -- node' added-leaf )
  44
  45 GENERIC: (pluck-at) ( key hashcode node -- node' )
  46
  47 GENERIC: >alist% ( node -- )
  48
  49 : >alist-each% ( nodes -- ) [ >alist% ] each ;
  50
  51 : mask ( hash shift -- n ) neg shift radix-mask bitand ; inline
  52
  53 : bitpos ( hash shift -- n ) mask 2^ ; inline
  54
  55 : smash ( idx seq -- seq/elt ? )
  56     dup length 2 = [ [ 1 = ] dip first2 ? f ] [ remove-nth t ] if ; inline
  57
  58 :: make-bitmap-node ( shift branch value key hashcode -- node' added-leaf )
  59     shift value key hashcode
  60     branch hashcode>> shift bitpos
  61     branch 1array
  62     shift
  63     <bitmap-node>
  64     (new-at) ; inline