diff --git a/cb/cb-test.factor b/trees/cb/cb-test.factor similarity index 100% rename from cb/cb-test.factor rename to trees/cb/cb-test.factor diff --git a/cb/cb.factor b/trees/cb/cb.factor similarity index 72% rename from cb/cb.factor rename to trees/cb/cb.factor index 4b9a30c..92e5161 100644 --- a/cb/cb.factor +++ b/trees/cb/cb.factor @@ -82,8 +82,13 @@ SYMBOL: current-key : byte-at ( byte# -- byte/0 ) key-bytes get ?nth [ 0 ] unless* ; +! For the current key and cb-node determin which side to go next +: select-side ( node -- node side ) + dup [ bits>> ] [ byte#>> ] bi + byte-at key-side ; + ! ** Insertion -! + ! Tree insertion must be done by traversing the tree from the root, as it is ! ordered. @@ -102,11 +107,10 @@ SYMBOL: current-key DEFER: cb-set ! Insert a node into a non-empty tree. -: (cb-set) ( value node -- node created? ) +: (cb-set) ( value parent node -- parent node created? ) dup cb-node? [ - dup [ bits>> ] [ byte#>> ] bi - byte-at key-side [ - [ node-link cb-set ] keep + select-side [ + [ node-link (cb-set) ] keep swap [ [ set-node-link ] keep ] dip ] with-side ] [ @@ -115,10 +119,49 @@ DEFER: cb-set ! Insert a node into the tree : cb-set ( value node -- node created? ) - [ (cb-set) ] [ current-key get swap t ] if* ; + [ dup (cb-set) ] [ current-key get swap t ] if* ; PRIVATE> M: cb set-at ( value key cb -- ) [ swap [ cb-set ] with-key swap ] change-root swap [ dup inc-count ] when drop ; + +! ** Deletion + +> current-key get = [ drop f t ] [ f ] if ; + +M: cb-node cb-delete ( node -- node deleted? ) + select-side [ + dup node-link dup cb-delete [ + ! ( node old-child new-child -- ) + [ + ! ( node old new ) + ! Deleted a split node (received some node) + tuck eq? [ + drop t + ] [ + swap tuck set-node-link + t + ] if + ] [ + ! Deleted a leaf node return other child. + drop + node+link t + ] if* + f + ] when drop + ] with-side ; + +PRIVATE> + +M: cb delete-at ( key cb -- ) + [ swap [ cb-delete ] with-key swap ] change-root + swap [ dup dec-count ] when drop ;