use radix literals

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

diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor
index 3ec1e96c7264d6cce43df3f934cc3397d9602479..3151bea80b1ed266b3c1b28503b5dd1160659830 100644 (file)
--- a/basis/serialize/serialize.factor
+++ b/basis/serialize/serialize.factor
@@ -8,11 +8,11 @@
 !
 USING: namespaces sequences kernel math io math.functions
 io.binary strings classes words sbufs classes.tuple arrays
-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 ;
+vectors byte-arrays quotations hashtables hashtables.identity
+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 vocabs ;
 IN: serialize
 
 GENERIC: (serialize) ( obj -- )
@@ -22,22 +22,14 @@ GENERIC: (serialize) ( obj -- )
 ! Variable holding a assoc of objects already serialized
 SYMBOL: serialized
 
-TUPLE: id obj ;
-
-C: <id> id
-
-M: id hashcode* obj>> hashcode* ;
-
-M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
-
 : add-object ( obj -- )
     #! Add an object to the sequence of already serialized
     #! objects.
-    serialized get [ assoc-size swap <id> ] keep set-at ;
+    serialized get [ assoc-size swap ] keep set-at ;
 
 : object-id ( obj -- id )
     #! Return the id of an already serialized object 
-    <id> serialized get at ;
+    serialized get at ;
 
 ! Numbers are serialized as follows:
 ! 0 => B{ 0 }
@@ -47,25 +39,25 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
 ! 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 ] [
-        dup HEX: 7e <= [
-            HEX: 80 bitor write1
+    [ 0 write1 ] [
+        dup 0x7e <= [
+            0x80 bitor write1
         ] [
-            dup log2 8 /i 1+ 
-            dup HEX: 7f >= [
-                HEX: ff write1
+            dup log2 8 /i 1 + 
+            dup 0x7f >= [
+                0xff write1
                 dup serialize-cell
             ] [
                 dup write1
             ] if
             >be write
         ] if
-    ] if ;
+    ] if-zero ;
 
 : deserialize-cell ( -- n )
     read1 {
-        { [ dup HEX: ff = ] [ drop deserialize-cell read be> ] }
-        { [ dup HEX: 80 >= ] [ HEX: 80 bitxor ] }
+        { [ dup 0xff = ] [ drop deserialize-cell read be> ] }
+        { [ dup 0x80 >= ] [ 0x80 bitxor ] }
         [ read be> ]
     } cond ;
 
@@ -79,27 +71,17 @@ 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
@@ -111,7 +93,7 @@ M: ratio (serialize) ( obj -- )
 M: tuple (serialize) ( obj -- )
     [
         CHAR: T write1
-        [ class (serialize) ]
+        [ class-of (serialize) ]
         [ add-object ]
         [ tuple>array rest (serialize) ]
         tri
@@ -180,7 +162,7 @@ M: wrapper (serialize) ( obj -- )
     CHAR: W write1
     wrapped>> (serialize) ;
 
-DEFER: (deserialize) ( -- obj )
+DEFER: (deserialize)
 
 SYMBOL: deserialized
 
@@ -205,12 +187,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 ;
 
@@ -218,11 +194,10 @@ SYMBOL: deserialized
     (deserialize-string) dup intern-object ;
 
 : deserialize-word ( -- word )
-    (deserialize) (deserialize) 2dup lookup
+    (deserialize) (deserialize) 2dup [ require ] keep lookup-word
     dup [ 2nip ] [
         drop
-        "Unknown word: " -rot
-        2array unparse append throw
+        2array unparse "Unknown word: " prepend throw
     ] if ;
 
 : deserialize-gensym ( -- word )
@@ -239,7 +214,7 @@ SYMBOL: deserialized
 :: (deserialize-seq) ( exemplar quot -- seq )
     deserialize-cell exemplar new-sequence
     [ intern-object ]
-    [ dup [ drop quot call ] change-each ] bi ; inline
+    [ [ drop quot call ] map! ] bi ; inline
 
 : deserialize-array ( -- array )
     { } [ (deserialize) ] (deserialize-seq) ;
@@ -253,11 +228,11 @@ SYMBOL: deserialized
 : deserialize-hashtable ( -- hashtable )
     H{ } clone
     [ intern-object ]
-    [ (deserialize) update ]
+    [ (deserialize) assoc-union! drop ]
     [ ] tri ;
 
 : copy-seq-to-tuple ( seq tuple -- )
-    [ dup length ] dip [ set-array-nth ] curry 2each ;
+    [ set-array-nth ] curry each-index ;
 
 : deserialize-tuple ( -- array )
     #! Ugly because we have to intern the tuple before reading
@@ -280,7 +255,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 ] }
@@ -288,7 +262,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 ] }
@@ -308,10 +281,10 @@ PRIVATE>
     [ (deserialize) ] with-variable ;
 
 : serialize ( obj -- )
-    H{ } clone serialized [ (serialize) ] with-variable ;
+    IH{ } clone serialized [ (serialize) ] with-variable ;
 
 : bytes>object ( bytes -- obj )
     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 ;