]> gitweb.factorcode.org Git - factor.git/commitdiff
fixed serialization of factor words/quotations
authorSascha Matzke <sascha.matzke@didolo.org>
Mon, 11 May 2009 13:37:47 +0000 (15:37 +0200)
committerSascha Matzke <sascha.matzke@didolo.org>
Mon, 11 May 2009 13:37:47 +0000 (15:37 +0200)
extra/bson/reader/reader.factor
extra/bson/writer/writer.factor

index 96cde41c2b72f60d0e68d076c0f72b3b0158f555..9f1d8c31d294476a5c9f2001994f62b9641655f9 100644 (file)
@@ -181,19 +181,16 @@ M: bson-oid element-data-read ( type -- oid )
     read-longlong
     read-int32 oid boa ;
 
-M: bson-binary-custom element-binary-read ( size type -- dbref )
-    2drop
-    read-cstring
-    read-cstring objref boa ;
-
 M: bson-binary-bytes element-binary-read ( size type -- bytes )
     drop read ;
 
-M: bson-binary-function element-binary-read ( size type -- quot )
+M: bson-binary-custom element-binary-read ( size type -- quot )
     drop read bytes>object ;
 
 PRIVATE>
 
+USE: tools.continuations
+
 : stream>assoc ( exemplar -- assoc bytes-read )
     <state> dup state
     [ read-int32 >>size read-elements ] with-variable 
index 1b9d45b1241495c360fb72c93d603b6d9a79baf0..682257558f36710b961006f2e5217c26cd06416d 100644 (file)
@@ -62,7 +62,6 @@ M: t bson-type? ( boolean -- type ) drop T_Boolean ;
 M: f bson-type? ( boolean -- type ) drop T_Boolean ; 
 
 M: real bson-type? ( real -- type ) drop T_Double ; 
-M: word bson-type? ( word -- type ) drop T_String ; 
 M: tuple bson-type? ( tuple -- type ) drop T_Object ;  
 M: sequence bson-type? ( seq -- type ) drop T_Array ;
 M: string bson-type? ( string -- type ) drop T_String ; 
@@ -73,6 +72,7 @@ M: mdbregexp bson-type? ( regexp -- type ) drop T_Regexp ;
 
 M: oid bson-type? ( word -- type ) drop T_OID ;
 M: objref bson-type? ( objref -- type ) drop T_Binary ;
+M: word bson-type? ( word -- type ) drop T_Binary ;
 M: quotation bson-type? ( quotation -- type ) drop T_Binary ; 
 M: byte-array bson-type? ( byte-array -- type ) drop T_Binary ; 
 
@@ -112,21 +112,8 @@ M: byte-array bson-write ( binary -- )
     T_Binary_Bytes write-byte
     write ; 
 
-M: quotation bson-write ( quotation -- )
-    object>bytes [ length write-int32 ] keep
-    T_Binary_Function write-byte
-    write ; 
-
 M: oid bson-write ( oid -- )
     [ a>> write-longlong ] [ b>> write-int32 ] bi ;
-
-M: objref bson-write ( objref -- )
-    [ binary ] dip
-    '[ _
-       [ ns>> write-cstring ]
-       [ objid>> write-cstring ] bi ] with-byte-writer
-    [ length write-int32 ] keep
-    T_Binary_Custom write-byte write ;
        
 M: mdbregexp bson-write ( regexp -- )
    [ regexp>> write-cstring ]
@@ -149,7 +136,16 @@ M: assoc bson-write ( assoc -- )
        [ over skip-field? [ 2drop ] [ write-pair ] if ] assoc-each
        write-eoo ] with-length-prefix ; 
 
-M: word bson-write name>> bson-write ;
+: (serialize-code) ( code -- )
+    object>bytes [ length write-int32 ] keep
+    T_Binary_Custom write-byte
+    write ;
+
+M: quotation bson-write ( quotation -- )
+    (serialize-code) ;
+    
+M: word bson-write ( word -- )
+    (serialize-code) ;
 
 PRIVATE>