From f06eda5f16be4cd95600377c21cadb1014514bb7 Mon Sep 17 00:00:00 2001
From: Michael Raitza <git@spacefrogg.net>
Date: Tue, 11 Feb 2020 22:30:10 +0100
Subject: [PATCH] WIP Deactivate broken insert code and rewrite

 Split into:
 - walk for best fit
 - updating leaf / creating new split node and leaf node
 - insert new split node if necessary (WIP)
---
 trees/cb/cb.factor | 118 +++++++++++++++++++++++++++++++++++----------
 1 file changed, 92 insertions(+), 26 deletions(-)

diff --git a/trees/cb/cb.factor b/trees/cb/cb.factor
index 92e5161..1aa04fd 100644
--- a/trees/cb/cb.factor
+++ b/trees/cb/cb.factor
@@ -68,14 +68,15 @@ TUPLE: cb-node { byte# integer } { bits integer } left right ;
 ! environment for it with =with-key=.
 SYMBOL: key-bytes
 SYMBOL: current-key
+SYMBOL: new-side
 
 : key>bytes ( key -- bytes )
     object>bytes ;
 
 : with-key ( key quot -- )
     [
-        { current-key key-bytes } swap
-        dup key>bytes 2array zip
+        { current-key key-bytes new-side } swap
+        dup key>bytes left 3array zip
     ] dip with-variables ; inline
 
 ! Extract the critical byte
@@ -92,39 +93,104 @@ SYMBOL: current-key
 ! Tree insertion must be done by traversing the tree from the root, as it is
 ! ordered.
 
-! Insert a node at a leaf-node by first inserting a split node.
-: cb-insert ( value leaf-node -- node created? )
-    [ current-key get swap <node> ] dip
-    dup key>> key>bytes key-bytes get swap
-    bytes-diff swap <cb-node>
-    ! ( new-leaf old-leaf side cb-node -- )
-    [ swap
-      [ [ set-node-link ] keep
-        set-node+link
-      ] with-side
-    ] keep t ;
+! ! Insert a node at a leaf-node by first inserting a split node.
+! : cb-insert ( value leaf-node -- node created? )
+!     [ current-key get swap <node> ] dip
+!     dup key>> key>bytes key-bytes get swap
+!     bytes-diff swap <cb-node>
+!     ! ( new-leaf old-leaf side cb-node -- )
+!     [ swap
+!       [ [ set-node-link ] keep
+!         set-node+link
+!       ] with-side
+!     ] keep t ;
 
-DEFER: cb-set
+! DEFER: cb-set
 
-! Insert a node into a non-empty tree.
-: (cb-set) ( value parent node -- parent node created? )
-    dup cb-node? [
-        select-side [
-            [ node-link (cb-set) ] keep
-            swap [ [ set-node-link ] keep ] dip
-        ] with-side
+! ! Insert a node into a non-empty tree.
+! : (cb-set) ( value parent node -- parent node created? )
+!     dup cb-node? [
+!         select-side [
+!             [ node-link (cb-set) ] keep
+!             swap [ [ set-node-link ] keep ] dip
+!         ] with-side
+!     ] [
+!         cb-insert
+!     ] if ;
+
+! ! Insert a node into the tree
+! : cb-set ( value node -- node created? )
+!     [ dup (cb-set) ] [ current-key get swap <node> t ] if* ;
+
+! ** Walking the tree for the best fit
+
+! We need to remember the parent node as it will be the split node where our new
+! value starts to differ, should it not be (key-)identical with the current
+! node. Start with =f= as the parent.
+
+GENERIC: cb-best-fit ( parent/f node -- node child )
+
+M: f cb-best-fit ;
+
+M: node cb-best-fit ;
+
+M: cb-node cb-best-fit
+    select-side [
+        nip dup node-link cb-best-fit
+    ] with-side ;
+
+GENERIC: cb-update ( value parent/f node -- node created? )
+
+M: f cb-update
+    2drop current-key get swap <node> t ;
+
+: attach-node ( value side cb-node -- cb-node )
+    swap [
+        [ current-key get swap <node> ] dip
+        [ set-node+link ] keep
+    ] with-side ;
+
+M: node cb-update
+    dup key>> current-key get = [
+        current-key get >>key
+        nip swap >>value f
     ] [
-        cb-insert
+        dup key>> key>bytes key-bytes get swap
+        bytes-diff swap <cb-node>
+        attach-node t
     ] if ;
 
-! Insert a node into the tree
-: cb-set ( value node -- node created? )
-    [ dup (cb-set) ] [ current-key get swap <node> t ] if* ;
+GENERIC: cb-insert ( new-node cur-node -- node )
+
+M: f cb-insert drop ;
+
+M: node cb-insert
+    new-side get [
+        swap [ set-node-link ] keep
+    ] with-side ;
+
+M: cb-node cb-insert
+    2dup
+    [ [ [ byte#>> ] bi@ < ]
+      [ [ [ byte#>> ] bi@ = ]
+        [ [ bits>> ] bi@ <]
+      ] 2&&
+    ] 2|| [
+        ! break
+        select-side [ set-node-link ] with-side
+    ] [
+        ! step down
+    ] if
+
 
 PRIVATE>
 
 M: cb set-at ( value key cb -- )
-    [ swap [ cb-set ] with-key swap ] change-root
+    [ swap
+      [ ! ( value root -- new created? root )
+          [ f swap cb-best-fit cb-update ] keep swap
+          [ cb-insert t ] [ 2nip f ] if
+      ] with-key swap ] change-root
     swap [ dup inc-count ] when drop ;
 
 ! ** Deletion