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

Vocabulary

persistent.hashtables.nodes

Inputs

shift	an object
value	an object
key	an object
hashcode	an object
node	an object

Outputs

node'	an object
added-leaf	an object

Definition

IN: persistent.hashtables.nodes

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

Methods

USING: accessors kernel 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 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 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 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 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
    ;