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     [let* | shift [ bitmap-node shift>> ]
  14             bit [ hashcode shift bitpos ]
  15             bitmap [ bitmap-node bitmap>> ]
  16             nodes [ bitmap-node 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
  24 M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-leaf )
  25     [let* | shift [ bitmap-node shift>> ]
  26             bit [ hashcode shift bitpos ]
  27             bitmap [ bitmap-node bitmap>> ]
  28             idx [ bit bitmap index ]
  29             nodes [ bitmap-node nodes>> ] |
  30         bitmap bit bitand 0 eq? [
  31             [let | new-leaf [ value key hashcode <leaf-node> ] |
  32                 bitmap bit bitor
  33                 new-leaf idx nodes insert-nth
  34                 shift
  35                 <bitmap-node>
  36                 new-leaf
  37             ]
  38         ] [
  39             [let | n [ idx nodes nth ] |
  40                 shift radix-bits + value key hashcode n (new-at)
  41                 [let | new-leaf [ ] n' [ ] |
  42                     n n' eq? [
  43                         bitmap-node
  44                     ] [
  45                         bitmap
  46                         n' idx nodes new-nth
  47                         shift
  48                         <bitmap-node>
  49                     ] if
  50                     new-leaf
  51                 ]
  52             ]
  53         ] if
  54     ] ;
  55
  56 M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )
  57     [let | bit [ hashcode bitmap-node shift>> bitpos ]
  58            bitmap [ bitmap-node bitmap>> ]
  59            nodes [ bitmap-node nodes>> ]
  60            shift [ bitmap-node shift>> ] |
  61            bit bitmap bitand 0 eq? [ bitmap-node ] [
  62             [let* | idx [ bit bitmap index ]
  63                     n [ idx nodes nth-unsafe ]
  64                     n' [ key hashcode n (pluck-at) ] |
  65                 n n' eq? [
  66                     bitmap-node
  67                 ] [
  68                     n' [
  69                         bitmap
  70                         n' idx nodes new-nth
  71                         shift
  72                         <bitmap-node>
  73                     ] [
  74                         bitmap bit eq? [ f ] [
  75                             bitmap bit bitnot bitand
  76                             idx nodes remove-nth
  77                             shift
  78                             <bitmap-node>
  79                         ] if
  80                     ] if
  81                 ] if
  82             ]
  83         ] if
  84     ] ;
  85
  86 M: bitmap-node >alist% ( node -- ) nodes>> >alist-each% ;