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

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