spacefrogg
/
critbit
1
0
Fork 0
Code Releases Activity

WIP Fix difference algorithm

master
Michael Raitza 2020-12-05 13:15:50 +01:00
parent 642aaf718c
commit 1f66561cdc
1 changed files with 21 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
trees/cb/cb.factor
View File

@ -14,10 +14,11 @@
! 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 alien arrays assocs byte-arrays combinators.short-circuit fry
io.binary io.encodings.binary io.encodings.private io.encodings.string
io.encodings.utf8 kernel layouts locals make math math.private namespaces parser
prettyprint.custom sequences serialize strings trees trees.private vectors ;
USING: accessors alien arrays assocs byte-arrays combinators
combinators.short-circuit fry io.binary io.encodings.binary io.encodings.private
io.encodings.string io.encodings.utf8 kernel layouts locals make math
math.private namespaces parser prettyprint.custom sequences serialize strings
trees trees.private vectors ;
IN: trees.cb
TUPLE: cb < tree ;
@ -53,17 +54,31 @@ TUPLE: cb-node { byte# integer } { bits integer } left right ;
bitxor msb0
[ key-side ] keep ;
: elt-from-long-seq ( seq1 seq2 -- elt i/f )
2dup [ length ] bi@ {
{ [ 2dup > ] [ 2nip [ swap nth ] keep ] }
{ [ 2dup < ] [ drop [ drop ] 2dip [ swap nth ] keep ] }
[ 4drop 0 f ]
} cond ;
: order-by-length ( seq1 seq2 -- seq-short seq-long )
2dup [ length ] bi@ > [ swap ] when ;
! For two byte strings, calculate the critical bit, byte and direction of
! difference (0 = left, 1 = right).
: bytes-diff ( newbytes oldbytes -- side bits byte# )
! difference.
: (bytes-diff) ( newbytes oldbytes -- side bits byte# )
2dup mismatch
[
[ '[ _ swap nth ] bi@ byte-diff ] keep
] [
! Equal prefix over full (shorter) byte sequence.
elt-from-long-seq [ [ 0 ] dip ] [ ] if* ;
[ 1 255 ] 2dip shorter length 1 -
] if* ;
: bytes-diff ( newbytes oldbytes -- side bits byte#/f )
bytes-diff ;
PRIVATE>
GENERIC: key>bytes* ( key -- bytes )