From c8d3ba4d59b1d4299bf457e3eea121edf806c366 Mon Sep 17 00:00:00 2001
From: Michael Raitza <git@spacefrogg.net>
Date: Tue, 23 Apr 2019 23:00:38 +0200
Subject: [PATCH] WIP: Searching, node calculation, put into empty tree

 Misses insertion of a node into the tree
---
 critbit/critbit.factor | 61 ++++++++++++++++++++++++++++++++++--------
 1 file changed, 50 insertions(+), 11 deletions(-)

diff --git a/critbit/critbit.factor b/critbit/critbit.factor
index b20a6d9..1c23be5 100644
--- a/critbit/critbit.factor
+++ b/critbit/critbit.factor
@@ -1,4 +1,17 @@
-USING: accessors kernel math sequences serialize ;
+! * Crit-bit trees
+! ** Rationale
+! Critbit trees are described in [[https://cr.yp.to/critbit.html][djb's crit-bit tree]]. They are an evolution of
+! PATRICIA trees showing that fast insertion, deletion, exact searching and suffix
+! searching is possible with this data structure.
+
+! The strength of this datastructure, according to its author, lies in its simple
+! design and its optimisation to be machine parsable using machine word-sized
+! operations where possible. Like PATRICIA trees, crit-bit trees are
+! prefix-compressed, with internal nodes storing next decision point (the critical
+! bit) in a length field (encoded as an integer and a mask) and two successor
+! pointers. Arbitrary data objects make up its leaves.
+
+USING: accessors fry kernel math sequences serialize ;
 
 IN: critbit
 
@@ -19,12 +32,12 @@ PRIVATE>
 
 TUPLE: node left right { byte# integer } { bits integer } ;
 
-: new-node ( byte# bits class -- node )
+: new-node ( bits byte# class -- node )
     new
     swap >>byte#
     swap >>bits ; inline
 
-: <node> ( byte# bits -- node )
+: <node> ( bits byte# -- node )
     node new-node ;
 
 PRIVATE>
@@ -45,25 +58,51 @@ PRIVATE>
     [ 2dup swap length < [ swap nth ] [ 2drop 0 ] if ] dip
     direction 0 = [ left>> ] [ right>> ] if ;
 
-: walk-critbit ( bytes obj -- bytes obj )
+: walk-critbit ( obj tree -- bytes treebytes )
+    [ object>bytes ] [ root>> ] bi*
     [ dup node? ] [ successor ] while ;
 
 PRIVATE>
 
 : member? ( obj tree -- ? )
     dup critbit?
-    [ [ object>bytes ] [ root>> ] bi* walk-critbit = ]
+    [ walk-critbit = ]
     [ 2drop f ] if ;
 
-: find-byte ( newbytes oldbytes -- x )
-    2dup [ bitxor dup 0 = ] 2all?
-    [ [ length ] dip nth ]
-    [ ] if;
+<PRIVATE
+
+! Produce a byte with all bits set except the msb from bits*.
+! See MAGIC Algorithms for rationale.
+: msb0 ( bits* -- bits )
+    dup -1 shift bitor
+    dup -2 shift bitor
+    dup -4 shift bitor
+    dup -1 shift bitnot bitand 255 bitxor ;
+
+: byte-params ( newbyte oldbyte -- direction bits )
+    swap over
+    bitxor msb0
+    [ direction ] keep ;
+
+: node-params ( newbytes oldbytes -- direction bits byte# )
+    2dup mismatch
+    ! newbytes oldbytes byte# -> direction bits byte#
+    [ [ '[ _ swap nth ] bi@ byte-params ] keep ]
+    [ 2dup [ length ] bi@ - 0 < [ drop ] [ nip ] if
+      [ last ] [ length 1 - ] bi
+      [ dup byte-params ] dip
+    ] if* ;
+
+PRIVATE>
 
 : put ( obj tree -- tree )
     dup critbit?
     [ dup empty?
       [ swap object>bytes >>root ]
-      [ [ object>bytes ] [ root>> ] bi* walk-critbit
-        ] if ]
+      [ walk-critbit
+        [ dup ] dip
+        node-params
+        <node>
+        swap 0 = [ swap >>right ] [ swap >>left ] if
+      ] if ]
     [ 2drop "Not a critbit tree" throw ] if ;