steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fixed serialization of factor words/quotations

Sascha Matzke 2009-05-11 15:37:47 +02:00
parent 9b66b2a9ab
commit f8eeea64f2
2 changed files with 14 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
extra/bson/reader/reader.factor
View File

@ -181,19 +181,16 @@ M: bson-oid element-data-read ( type -- oid )
read-longlong read-longlong
read-int32 oid boa ; 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 ) M: bson-binary-bytes element-binary-read ( size type -- bytes )
drop read ; 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 ; drop read bytes>object ;
PRIVATE> PRIVATE>
USE: tools.continuations
: stream>assoc ( exemplar -- assoc bytes-read ) : stream>assoc ( exemplar -- assoc bytes-read )
<state> dup state <state> dup state
[ read-int32 >>size read-elements ] with-variable [ read-int32 >>size read-elements ] with-variable

26
extra/bson/writer/writer.factor
View File

@ -62,7 +62,6 @@ M: t bson-type? ( boolean -- type ) drop T_Boolean ;
M: f 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: 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: tuple bson-type? ( tuple -- type ) drop T_Object ;
M: sequence bson-type? ( seq -- type ) drop T_Array ; M: sequence bson-type? ( seq -- type ) drop T_Array ;
M: string bson-type? ( string -- type ) drop T_String ; 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: oid bson-type? ( word -- type ) drop T_OID ;
M: objref bson-type? ( objref -- type ) drop T_Binary ; 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: quotation bson-type? ( quotation -- type ) drop T_Binary ;
M: byte-array bson-type? ( byte-array -- 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 T_Binary_Bytes write-byte
write ; write ;
M: quotation bson-write ( quotation -- )
object>bytes [ length write-int32 ] keep
T_Binary_Function write-byte
write ;
M: oid bson-write ( oid -- ) M: oid bson-write ( oid -- )
[ a>> write-longlong ] [ b>> write-int32 ] bi ; [ 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 -- ) M: mdbregexp bson-write ( regexp -- )
[ regexp>> write-cstring ] [ regexp>> write-cstring ]
@ -149,7 +136,16 @@ M: assoc bson-write ( assoc -- )
[ over skip-field? [ 2drop ] [ write-pair ] if ] assoc-each [ over skip-field? [ 2drop ] [ write-pair ] if ] assoc-each
write-eoo ] with-length-prefix ; 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> PRIVATE>