factor: trim using lists

[factor.git] / basis / serialize / serialize.factor

diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor
index 2a79beabf29ef77ba0295750f8d3f20bdc1dab4d..2f305bc174c8f0a6c58c88d967ecafcb12cbab7e 100644 (file)
--- a/basis/serialize/serialize.factor
+++ b/basis/serialize/serialize.factor
@@ -7,10 +7,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 !
 USING: accessors arrays assocs byte-arrays classes classes.tuple
-combinators hashtables hashtables.identity io io.binary
-io.encodings.binary io.encodings.string io.encodings.utf8
-io.streams.byte-array kernel locals math namespaces prettyprint
-quotations sequences sequences.private strings vocabs words ;
+combinators endian hashtables io io.encodings.binary
+io.encodings.string io.encodings.utf8 io.streams.byte-array
+kernel math namespaces prettyprint quotations sequences
+sequences.private strings vocabs words ;
 IN: serialize
 
 GENERIC: (serialize) ( obj -- )
@@ -21,28 +21,28 @@ GENERIC: (serialize) ( obj -- )
 SYMBOL: serialized
 
 : add-object ( obj -- )
-    #! Add an object to the sequence of already serialized
-    #! objects.
+    ! Add an object to the sequence of already serialized
+    ! objects.
     serialized get [ assoc-size swap ] keep set-at ;
 
 : object-id ( obj -- id )
-    #! Return the id of an already serialized object
+    ! Return the id of an already serialized object
     serialized get at ;
 
-! Numbers are serialized as follows:
+! Positive numbers are serialized as follows:
 ! 0 => B{ 0 }
-! 1<=x<=126 => B{ x | 0x80 }
-! x>127 => B{ length(x) x[0] x[1] ... }
-! x>2^1024 => B{ 0xff length(x) x[0] x[1] ... }
+! 1<=x<127 => B{ x | 0x80 }
+! 127<=x<2^1024 => B{ length(x) x[0] x[1] ... }; 1<length(x)<129 fits in 1 byte
+! 2^1024<=x => B{ 0xff } + serialize(length(x)) + B{ x[0] x[1] ... }
 ! The last case is needed because a very large number would
 ! otherwise be confused with a small number.
 : serialize-cell ( n -- )
     [ 0 write1 ] [
-        dup 0x7e <= [
+        dup 0x7f < [
             0x80 bitor write1
         ] [
             dup log2 8 /i 1 +
-            dup 0x7f >= [
+            dup 0x80 > [
                 0xff write1
                 dup serialize-cell
             ] [
@@ -55,7 +55,7 @@ SYMBOL: serialized
 : deserialize-cell ( -- n )
     read1 {
         { [ dup 0xff = ] [ drop deserialize-cell read be> ] }
-        { [ dup 0x80 >= ] [ 0x80 bitxor ] }
+        { [ dup 0x80 > ] [ 0x80 bitxor ] }
         [ read be> ]
     } cond ;
 
@@ -65,10 +65,10 @@ SYMBOL: serialized
         [ CHAR: o write1 serialize-cell drop ]
     ] dip if* ; inline
 
-M: f (serialize) ( obj -- )
+M: f (serialize)
     drop CHAR: n write1 ;
 
-M: integer (serialize) ( obj -- )
+M: integer (serialize)
     [
         CHAR: z write1
     ] [
@@ -76,7 +76,7 @@ M: integer (serialize) ( obj -- )
         serialize-cell
     ] if-zero ;
 
-M: float (serialize) ( obj -- )
+M: float (serialize)
     CHAR: F write1
     double>bits serialize-cell ;
 
@@ -88,7 +88,7 @@ M: float (serialize) ( obj -- )
         [ [ (serialize) ] each ] tri
     ] curry serialize-shared ;
 
-M: tuple (serialize) ( obj -- )
+M: tuple (serialize)
     [
         CHAR: T write1
         [ class-of (serialize) ]
@@ -97,22 +97,22 @@ M: tuple (serialize) ( obj -- )
         tri
     ] serialize-shared ;
 
-M: array (serialize) ( obj -- )
+M: array (serialize)
     CHAR: a serialize-seq ;
 
-M: quotation (serialize) ( obj -- )
+M: quotation (serialize)
     [
         CHAR: q write1
         [ >array (serialize) ] [ add-object ] bi
     ] serialize-shared ;
 
-M: hashtable (serialize) ( obj -- )
+M: hashtable (serialize)
     [
         CHAR: h write1
         [ add-object ] [ >alist (serialize) ] bi
     ] serialize-shared ;
 
-M: byte-array (serialize) ( obj -- )
+M: byte-array (serialize)
     [
         CHAR: A write1
         [ add-object ]
@@ -120,7 +120,7 @@ M: byte-array (serialize) ( obj -- )
         [ write ] tri
     ] serialize-shared ;
 
-M: string (serialize) ( obj -- )
+M: string (serialize)
     [
         CHAR: s write1
         [ add-object ]
@@ -149,14 +149,14 @@ M: string (serialize) ( obj -- )
     [ vocabulary>> (serialize) ]
     bi ;
 
-M: word (serialize) ( obj -- )
+M: word (serialize)
     {
         { [ dup t eq? ] [ serialize-true ] }
         { [ dup vocabulary>> not ] [ serialize-gensym ] }
         [ serialize-word ]
     } cond ;
 
-M: wrapper (serialize) ( obj -- )
+M: wrapper (serialize)
     CHAR: W write1
     wrapped>> (serialize) ;
 
@@ -231,8 +231,8 @@ SYMBOL: deserialized
     [ set-array-nth ] curry each-index ;
 
 : deserialize-tuple ( -- array )
-    #! Ugly because we have to intern the tuple before reading
-    #! slots
+    ! Ugly because we have to intern the tuple before reading
+    ! slots
     (deserialize) new
     [ intern-object ]
     [