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) :> ( n' new-leaf )
  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     ] if ;
  50
  51 M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )
  52     hashcode bitmap-node shift>> bitpos :> bit
  53     bitmap-node bitmap>> :> bitmap
  54     bitmap-node nodes>> :> nodes
  55     bitmap-node shift>> :> shift
  56     bit bitmap bitand 0 eq? [ bitmap-node ] [
  57         bit bitmap index :> idx
  58         idx nodes nth-unsafe :> n
  59         key hashcode n (pluck-at) :> n'
  60         n n' eq? [
  61             bitmap-node
  62         ] [
  63             n' [
  64                 bitmap
  65                 n' idx nodes new-nth
  66                 shift
  67                 <bitmap-node>
  68             ] [
  69                 bitmap bit eq? [ f ] [
  70                     bitmap bit bitnot bitand
  71                     idx nodes remove-nth
  72                     shift
  73                     <bitmap-node>
  74                 ] if
  75             ] if
  76         ] if
  77     ] if ;
  78
  79 M: bitmap-node >alist% nodes>> >alist-each% ;