basis/persistent/hashtables/nodes/collision/collision.factor

   1 ! Based on Clojure's PersistentHashMap by Rich Hickey.
   2
   3 USING: kernel accessors math arrays fry sequences
   4 locals persistent.sequences
   5 persistent.hashtables.config
   6 persistent.hashtables.nodes
   7 persistent.hashtables.nodes.leaf ;
   8 IN: persistent.hashtables.nodes.collision
   9
  10 : find-index ( key hashcode collision-node -- n leaf-node )
  11     leaves>> -rot '[ , , _ matching-key? ] find ; inline
  12
  13 M:: collision-node (entry-at) ( key hashcode collision-node -- leaf-node )
  14     key hashcode collision-node find-index nip ;
  15
  16 M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node )
  17     hashcode collision-node hashcode>> eq? [
  18         [let | idx [ key hashcode collision-node find-index drop ] |
  19             idx [
  20                 idx collision-node leaves>> smash [
  21                     collision-node hashcode>>
  22                     <collision-node>
  23                 ] when
  24             ] [ collision-node ] if
  25         ]
  26     ] [ collision-node ] if ;
  27
  28 M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' added-leaf )
  29     hashcode collision-node hashcode>> eq? [
  30         key hashcode collision-node find-index
  31         [let | leaf-node [ ] idx [ ] |
  32             idx [
  33                 value leaf-node value>> = [
  34                     collision-node f
  35                 ] [
  36                     hashcode
  37                     value key hashcode <leaf-node>
  38                     idx
  39                     collision-node leaves>>
  40                     new-nth
  41                     <collision-node>
  42                     f
  43                 ] if
  44             ] [
  45                 [let | new-leaf-node [ value key hashcode <leaf-node> ] |
  46                     hashcode
  47                     collision-node leaves>>
  48                     new-leaf-node
  49                     suffix
  50                     <collision-node>
  51                     new-leaf-node
  52                 ]
  53             ] if
  54         ]
  55     ] [
  56         shift collision-node value key hashcode make-bitmap-node
  57     ] if ;
  58
  59 M: collision-node >alist% leaves>> >alist-each% ;