use radix literals

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

diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor
index da154444c1fcfe41e1f7abd79c0d25c0f9100991..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 vocabs.loader ;
+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 }
@@ -48,12 +40,12 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
 ! otherwise be confused with a small number.
 : serialize-cell ( n -- )
     [ 0 write1 ] [
-        dup HEX: 7e <= [
-            HEX: 80 bitor 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
@@ -64,8 +56,8 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
 
 : 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 ;
 
@@ -101,7 +93,7 @@ M: float (serialize) ( obj -- )
 M: tuple (serialize) ( obj -- )
     [
         CHAR: T write1
-        [ class (serialize) ]
+        [ class-of (serialize) ]
         [ add-object ]
         [ tuple>array rest (serialize) ]
         tri
@@ -170,7 +162,7 @@ M: wrapper (serialize) ( obj -- )
     CHAR: W write1
     wrapped>> (serialize) ;
 
-DEFER: (deserialize) ( -- obj )
+DEFER: (deserialize)
 
 SYMBOL: deserialized
 
@@ -202,7 +194,7 @@ SYMBOL: deserialized
     (deserialize-string) dup intern-object ;
 
 : deserialize-word ( -- word )
-    (deserialize) (deserialize) 2dup [ require ] keep lookup
+    (deserialize) (deserialize) 2dup [ require ] keep lookup-word
     dup [ 2nip ] [
         drop
         2array unparse "Unknown word: " prepend throw
@@ -222,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) ;
@@ -236,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
@@ -289,7 +281,7 @@ 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 ;