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

View 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

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: 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,22 +112,9 @@ 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 ]
[ options>> write-cstring ] bi ;
@ -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>