From 79b67e1ab3e264b9e42ba9cc2b64e7a0cad92675 Mon Sep 17 00:00:00 2001
From: Michael Raitza <git@spacefrogg.net>
Date: Mon, 24 Feb 2020 15:47:10 +0100
Subject: [PATCH] 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.
---
 trees/cb/cb.factor | 33 +++++++++++++++++++++++++++------
 1 file changed, 27 insertions(+), 6 deletions(-)

diff --git a/trees/cb/cb.factor b/trees/cb/cb.factor
index 69d306f..df0186d 100644
--- a/trees/cb/cb.factor
+++ b/trees/cb/cb.factor
@@ -14,9 +14,10 @@
 ! 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 arrays assocs combinators.short-circuit fry kernel locals make
-math namespaces parser prettyprint.custom sequences serialize trees
-trees.private vectors ;
+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 ;
 IN: trees.cb
 
 TUPLE: cb < tree ;
@@ -63,15 +64,35 @@ TUPLE: cb-node { byte# integer } { bits integer } left right ;
         [ 1 255 ] 2dip shorter length 1 -
     ] 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
 ! 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 new-side } swap