basis/persistent/hashtables/nodes/bitmap/bitmap.factor

   1 ! Based on Clojure's PersistentHashMap by Rich Hickey.
   2
   3 USING: math math.bitwise arrays kernel accessors locals sequences
   4 sequences.private
   5 persistent.sequences
   6 persistent.hashtables.config
   7 persistent.hashtables.nodes ;
   8 IN: persistent.hashtables.nodes.bitmap
   9
  10 : index ( bit bitmap -- n ) [ 1 - ] dip bitand bit-count ; inline
  11
  12 M:: bitmap-node (entry-at) ( key hashcode bitmap-node -- entry )
  13     bitmap-node shift>> :> shift
  14     hashcode shift bitpos :> bit
  15     bitmap-node bitmap>> :> bitmap
  16     bitmap-node nodes>> :> nodes
  17     bitmap bit bitand 0 eq? [ f ] [
  18         key hashcode
  19         bit bitmap index nodes nth-unsafe
  20         (entry-at)
  21     ] if ;
  22
  23 M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-leaf )
  24     bitmap-node shift>> :> shift
  25     hashcode shift bitpos :> bit
  26     bitmap-node bitmap>> :> bitmap
  27     bit bitmap index :> idx
  28     bitmap-node nodes>> :> nodes
  29
  30     bitmap bit bitand 0 eq? [
  31         value key hashcode <leaf-node> :> new-leaf
  32         bitmap bit bitor
  33         new-leaf idx nodes insert-nth
  34         shift
  35         <bitmap-node>
  36         new-leaf
  37     ] [
  38         idx nodes nth :> n
  39             shift radix-bits + value key hashcode n (new-at) :> new-leaf :> n'
  40             n n' eq? [
  41                 bitmap-node
  42             ] [
  43                 bitmap
  44                 n' idx nodes new-nth
  45                 shift
  46                 <bitmap-node>
  47             ] if
  48             new-leaf
  49         ]
  50     ] if ;
  51
  52 M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )
  53     hashcode bitmap-node shift>> bitpos :> bit
  54     bitmap-node bitmap>> :> bitmap
  55     bitmap-node nodes>> :> nodes
  56     bitmap-node shift>> :> shift
  57     bit bitmap bitand 0 eq? [ bitmap-node ] [
  58         bit bitmap index :> idx
  59         idx nodes nth-unsafe :> n
  60         key hashcode n (pluck-at) :> n'
  61         n n' eq? [
  62             bitmap-node
  63         ] [
  64             n' [
  65                 bitmap
  66                 n' idx nodes new-nth
  67                 shift
  68                 <bitmap-node>
  69             ] [
  70                 bitmap bit eq? [ f ] [
  71                     bitmap bit bitnot bitand
  72                     idx nodes remove-nth
  73                     shift
  74                     <bitmap-node>
  75                 ] if
  76             ] if
  77         ] if
  78     ] if ;
  79
  80 M: bitmap-node >alist% ( node -- ) nodes>> >alist-each% ;