USING: accessors kernel math sequences serialize ;

IN: critbit

TUPLE: critbit root ;

<PRIVATE

: new-critbit ( class -- critbit )
    new
    f >>root ; inline

PRIVATE>

: <critbit> ( -- critbit )
    critbit new-critbit ;

<PRIVATE

TUPLE: node left right { byte# integer } { bits integer } ;

: new-node ( byte# bits class -- node )
    new
    swap >>byte#
    swap >>bits ; inline

: <node> ( byte# bits -- node )
    node new-node ;

PRIVATE>

: empty? ( tree -- ? )
    root>> f = ; inline

! : walk-crit ( obj node -- ? )
!      ;

: direction ( byte bits -- direction )
    bitor 1 + -8 shift ;

<PRIVATE

: successor ( bytes node -- bytes successor )
    2dup [ byte#>> ] [ bits>> ] bi
    [ 2dup swap length < [ swap nth ] [ 2drop 0 ] if ] dip
    direction 0 = [ left>> ] [ right>> ] if ;

: walk-critbit ( bytes obj -- bytes obj )
    [ dup node? ] [ successor ] while ;

PRIVATE>

: member? ( obj tree -- ? )
    dup critbit?
    [ [ object>bytes ] [ root>> ] bi* walk-critbit = ]
    [ 2drop f ] if ;

: find-byte ( newbytes oldbytes -- x )
    2dup [ bitxor dup 0 = ] 2all?
    [ [ length ] dip nth ]
    [ ] if;

: put ( obj tree -- tree )
    dup critbit?
    [ dup empty?
      [ swap object>bytes >>root ]
      [ [ object>bytes ] [ root>> ] bi* walk-critbit
        ] if ]
    [ 2drop "Not a critbit tree" throw ] if ;