Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

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

diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor
index 52c1535886fe14dde59cc0e694da100db2a9dccf..2b4294bda4ca9250643d255b26c24be28945bcc5 100644 (file)
--- a/basis/serialize/serialize.factor
+++ b/basis/serialize/serialize.factor
@@ -12,9 +12,13 @@ vectors byte-arrays quotations hashtables assocs help.syntax
 help.markup splitting io.streams.byte-array io.encodings.string
 io.encodings.utf8 io.encodings.binary combinators accessors
 locals prettyprint compiler.units sequences.private
-classes.tuple.private ;
+classes.tuple.private vocabs.loader ;
 IN: serialize
 
+GENERIC: (serialize) ( obj -- )
+
+<PRIVATE
+
 ! Variable holding a assoc of objects already serialized
 SYMBOL: serialized
 
@@ -35,9 +39,6 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
     #! Return the id of an already serialized object 
     <id> serialized get at ;
 
-! Serialize object
-GENERIC: (serialize) ( obj -- )
-
 ! Numbers are serialized as follows:
 ! 0 => B{ 0 }
 ! 1<=x<=126 => B{ x | 0x80 }
@@ -46,11 +47,11 @@ GENERIC: (serialize) ( obj -- )
 ! The last case is needed because a very large number would
 ! otherwise be confused with a small number.
 : serialize-cell ( n -- )
-    dup zero? [ drop 0 write1 ] [
+    [ 0 write1 ] [
         dup HEX: 7e <= [
             HEX: 80 bitor write1
         ] [
-            dup log2 8 /i 1+ 
+            dup log2 8 /i 1 + 
             dup HEX: 7f >= [
                 HEX: ff write1
                 dup serialize-cell
@@ -59,7 +60,7 @@ GENERIC: (serialize) ( obj -- )
             ] if
             >be write
         ] if
-    ] if ;
+    ] if-zero ;
 
 : deserialize-cell ( -- n )
     read1 {
@@ -69,35 +70,26 @@ GENERIC: (serialize) ( obj -- )
     } cond ;
 
 : serialize-shared ( obj quot -- )
-    >r dup object-id
-    [ CHAR: o write1 serialize-cell drop ]
-    r> if* ; inline
+    [
+        dup object-id
+        [ CHAR: o write1 serialize-cell drop ]
+    ] dip if* ; inline
 
 M: f (serialize) ( obj -- )
     drop CHAR: n write1 ;
 
 M: integer (serialize) ( obj -- )
-    dup zero? [
-        drop CHAR: z write1
+    [
+        CHAR: z write1
     ] [
         dup 0 < [ neg CHAR: m ] [ CHAR: p ] if write1
         serialize-cell
-    ] if ;
+    ] if-zero ;
 
 M: float (serialize) ( obj -- )
     CHAR: F write1
     double>bits serialize-cell ;
 
-M: complex (serialize) ( obj -- )
-    CHAR: c write1
-    [ real-part (serialize) ]
-    [ imaginary-part (serialize) ] bi ;
-
-M: ratio (serialize) ( obj -- )
-    CHAR: r write1
-    [ numerator (serialize) ]
-    [ denominator (serialize) ] bi ;
-
 : serialize-seq ( obj code -- )
     [
         write1
@@ -203,12 +195,6 @@ SYMBOL: deserialized
 : deserialize-float ( -- float )
     deserialize-cell bits>double ;
 
-: deserialize-ratio ( -- ratio )
-    (deserialize) (deserialize) / ;
-
-: deserialize-complex ( -- complex )
-    (deserialize) (deserialize) rect> ;
-
 : (deserialize-string) ( -- string )
     deserialize-cell read utf8 decode ;
 
@@ -216,11 +202,10 @@ SYMBOL: deserialized
     (deserialize-string) dup intern-object ;
 
 : deserialize-word ( -- word )
-    (deserialize) (deserialize) 2dup lookup
+    (deserialize) (deserialize) 2dup [ require ] keep lookup
     dup [ 2nip ] [
         drop
-        "Unknown word: " -rot
-        2array unparse append throw
+        2array unparse "Unknown word: " prepend throw
     ] if ;
 
 : deserialize-gensym ( -- word )
@@ -255,7 +240,7 @@ SYMBOL: deserialized
     [ ] tri ;
 
 : copy-seq-to-tuple ( seq tuple -- )
-    >r dup length r> [ set-array-nth ] curry 2each ;
+    [ dup length ] dip [ set-array-nth ] curry 2each ;
 
 : deserialize-tuple ( -- array )
     #! Ugly because we have to intern the tuple before reading
@@ -278,7 +263,6 @@ SYMBOL: deserialized
             { CHAR: T [ deserialize-tuple ] }
             { CHAR: W [ deserialize-wrapper ] }
             { CHAR: a [ deserialize-array ] }
-            { CHAR: c [ deserialize-complex ] }
             { CHAR: h [ deserialize-hashtable ] }
             { CHAR: m [ deserialize-negative-integer ] }
             { CHAR: n [ deserialize-false ] }
@@ -286,7 +270,6 @@ SYMBOL: deserialized
             { CHAR: o [ deserialize-unknown ] }
             { CHAR: p [ deserialize-positive-integer ] }
             { CHAR: q [ deserialize-quotation ] }
-            { CHAR: r [ deserialize-ratio ] }
             { CHAR: s [ deserialize-string ] }
             { CHAR: w [ deserialize-word ] }
             { CHAR: G [ deserialize-word ] }
@@ -299,11 +282,11 @@ SYMBOL: deserialized
 : (deserialize) ( -- obj )
     deserialize* [ "End of stream" throw ] unless ;
 
+PRIVATE>
+
 : deserialize ( -- obj )
-    ! [
     V{ } clone deserialized
     [ (deserialize) ] with-variable ;
-    ! ] with-compilation-unit ;
 
 : serialize ( obj -- )
     H{ } clone serialized [ (serialize) ] with-variable ;
@@ -312,4 +295,4 @@ SYMBOL: deserialized
     binary [ deserialize ] with-byte-reader ;
 
 : object>bytes ( obj -- bytes )
-    binary [ serialize ] with-byte-writer ;
\ No newline at end of file
+    binary [ serialize ] with-byte-writer ;