1
0
Fork 0

Add a simpler and faster key serializer

Serialization of numeric keys and strings is faster but keys can no longer be
 freely mixed between object types as several serializations of different keys
 now coincide. Serializations of keys of a single type are guaranteed to be
 unique.
master
Michael Raitza 2020-02-24 15:47:10 +01:00
parent e3f4600c85
commit 79b67e1ab3
1 changed files with 27 additions and 6 deletions

View File

@ -14,9 +14,10 @@
! critical bit) in a length field (encoded as an integer and a mask) and two ! critical bit) in a length field (encoded as an integer and a mask) and two
! successor pointers. Arbitrary data objects make up its leaves. ! successor pointers. Arbitrary data objects make up its leaves.
USING: accessors arrays assocs combinators.short-circuit fry kernel locals make USING: accessors alien arrays assocs byte-arrays combinators.short-circuit fry
math namespaces parser prettyprint.custom sequences serialize trees io.binary io.encodings.binary io.encodings.private io.encodings.string
trees.private vectors ; io.encodings.utf8 kernel layouts locals make math math.private namespaces parser
prettyprint.custom sequences serialize strings trees trees.private vectors ;
IN: trees.cb IN: trees.cb
TUPLE: cb < tree ; TUPLE: cb < tree ;
@ -63,15 +64,35 @@ TUPLE: cb-node { byte# integer } { bits integer } left right ;
[ 1 255 ] 2dip shorter length 1 - [ 1 255 ] 2dip shorter length 1 -
] if* ; ] if* ;
PRIVATE>
GENERIC: key>bytes* ( key -- bytes )
M: object key>bytes*
object>bytes ;
M: byte-array key>bytes* ;
M: string key>bytes* utf8 encode ;
M: fixnum key>bytes* cell >le ;
M: bignum key>bytes* dup (log2) 8 /i 1 + >le ;
! Assumes that a double is never larger than a pointer
M: float key>bytes* double>bits cell >le ;
<PRIVATE
: key>bytes ( key -- bytes )
key>bytes* ;
! Keep the byte sequence of the current key in =key-bytes= and provide a working ! Keep the byte sequence of the current key in =key-bytes= and provide a working
! environment for it with =with-key=. ! environment for it with =with-key=.
SYMBOL: key-bytes SYMBOL: key-bytes
SYMBOL: current-key SYMBOL: current-key
SYMBOL: new-side SYMBOL: new-side
: key>bytes ( key -- bytes )
object>bytes ;
: with-key ( key quot -- ) : with-key ( key quot -- )
[ [
{ current-key key-bytes new-side } swap { current-key key-bytes new-side } swap