IN: persistent.hashtables.nodes

GENERIC: (new-at)
( shift value key hashcode node -- node' added-leaf )

USING: accessors kernel locals math
persistent.hashtables.config persistent.hashtables.nodes
persistent.hashtables.nodes.bitmap persistent.sequences
sequences ;

M:: bitmap-node (new-at)
( shift value key hashcode bitmap-node -- node' added-leaf )
bitmap-node shift>> :> shift hashcode shift bitpos
:> bit bitmap-node bitmap>> :> bitmap bit bitmap index
:> idx bitmap-node nodes>> :> nodes bitmap bit bitand 0 eq?
[
value key hashcode <leaf-node>
:> new-leaf bitmap bit bitor
new-leaf idx nodes insert-nth shift <bitmap-node>
new-leaf
] [
idx nodes nth :> n shift radix-bits +
value key hashcode n (new-at)
:> ( n' new-leaf ) n n' eq?
[ bitmap-node ]
[ bitmap n' idx nodes new-nth shift <bitmap-node> ] if
new-leaf
] if ;

USING: accessors kernel locals persistent.hashtables.nodes
persistent.hashtables.nodes.collision persistent.sequences
sequences ;

M:: collision-node (new-at)
( shift value key hashcode collision-node -- node' added-leaf )
hashcode collision-node hashcode>> eq? [
key hashcode collision-node find-index
:> ( idx leaf-node ) idx [
value leaf-node value>> =
[ collision-node f ] [
hashcode value key hashcode <leaf-node>
idx collision-node leaves>> new-nth
<collision-node> f
] if
] [
value key hashcode <leaf-node>
:> new-leaf-node hashcode collision-node leaves>>
new-leaf-node suffix <collision-node> new-leaf-node
] if
] [
shift collision-node value key hashcode
make-bitmap-node
] if ;

USING: kernel locals persistent.hashtables.nodes ;

M:: empty-node (new-at)
( shift value key hashcode node -- node' added-leaf )
value key hashcode <leaf-node> dup ;

USING: accessors kernel locals math
persistent.hashtables.config persistent.hashtables.nodes
persistent.sequences sequences.private ;

M:: full-node (new-at)
( shift value key hashcode full-node -- node' added-leaf )
full-node nodes>> :> nodes hashcode full-node shift>> mask
:> idx idx nodes nth-unsafe :> n shift radix-bits +
value key hashcode n (new-at) :> ( n' new-leaf ) n n' eq?
[ full-node ] [ n' idx nodes new-nth shift <full-node> ] if
new-leaf ;

USING: accessors arrays kernel locals
persistent.hashtables.nodes ;

M:: leaf-node (new-at)
( shift value key hashcode leaf-node -- node' added-leaf )
hashcode leaf-node hashcode>> eq? [
key leaf-node key>> = [
value leaf-node value>> =
[ leaf-node f ]
[ value key hashcode <leaf-node> f ] if
] [
value key hashcode <leaf-node>
:> new-leaf hashcode leaf-node new-leaf 2array
<collision-node> new-leaf
] if
] [ shift leaf-node value key hashcode make-bitmap-node ]
if ;