bson: some cleanup.

db4
John Benediktsson 2013-11-25 17:40:15 -08:00
parent 47a0ebcc99
commit 47e6b2e8fe
2 changed files with 22 additions and 16 deletions

View File

@ -4,7 +4,7 @@ io.streams.byte-array tools.test literals calendar kernel math ;
IN: bson.tests
: turnaround ( value -- value )
assoc>bv >byte-array binary [ H{ } clone stream>assoc ] with-byte-reader ;
assoc>bv binary [ H{ } clone stream>assoc ] with-byte-reader ;
[ H{ { "a" "a string" } } ] [ H{ { "a" "a string" } } turnaround ] unit-test
@ -35,15 +35,13 @@ IN: bson.tests
{ second 40+15437/200000 }
{ gmt-offset T{ duration { hour 2 } } } } } } turnaround
] unit-test
[ H{ { "nested" H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } }
{ "ref" T{ dbref f "a" "b" "c" } }
{ "array" H{ { "a list" { 1 2.234 "hello world" } } } }
{ "quot" [ 1 2 + ] } }
]
]
[ H{ { "nested" H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } }
{ "ref" T{ dbref f "a" "b" "c" } }
{ "array" H{ { "a list" { 1 2.234 "hello world" } } } }
{ "quot" [ 1 2 + ] } } turnaround ] unit-test

View File

@ -12,8 +12,8 @@ IN: bson.writer
<PRIVATE
CONSTANT: INT32-SIZE { 0 1 2 3 }
CONSTANT: INT64-SIZE { 0 1 2 3 4 5 6 7 }
CONSTANT: INT32-SIZE 4
CONSTANT: INT64-SIZE 8
PRIVATE>
@ -30,18 +30,20 @@ TYPED: with-length ( quot -- bytes-written: integer start-index: integer )
: with-length-prefix ( quot: ( .. -- .. ) -- )
[ ] (with-length-prefix) ; inline
: with-length-prefix-excl ( quot: ( .. -- .. ) -- )
[ 4 - ] (with-length-prefix) ; inline
: (>le) ( x n -- )
[ nth-byte write1 ] with each ; inline
<PRIVATE
TYPED: write-int32 ( int: integer -- ) INT32-SIZE (>le) ; inline
: write-le ( x n -- )
iota [ nth-byte write1 ] with each ; inline
TYPED: write-double ( real: float -- ) double>bits INT64-SIZE (>le) ; inline
TYPED: write-int32 ( int: integer -- )
INT32-SIZE write-le ; inline
TYPED: write-double ( real: float -- )
double>bits INT64-SIZE write-le ; inline
TYPED: write-utf8-string ( string: string -- )
get-output utf8 encode-string ; inline
@ -49,7 +51,8 @@ TYPED: write-utf8-string ( string: string -- )
TYPED: write-cstring ( string: string -- )
write-utf8-string 0 write1 ; inline
: write-longlong ( object -- ) INT64-SIZE (>le) ; inline
: write-longlong ( object -- )
INT64-SIZE write-le ; inline
: write-eoo ( -- ) T_EOO write1 ; inline
@ -164,5 +167,10 @@ TYPED: assoc>stream ( assoc: hashtables -- )
write-assoc ; inline
TYPED: mdb-special-value? ( value -- ?: boolean )
{ [ timestamp? ] [ quotation? ] [ mdbregexp? ]
[ oid? ] [ byte-array? ] } 1|| ; inline
{
[ timestamp? ]
[ quotation? ]
[ mdbregexp? ]
[ oid? ]
[ byte-array? ]
} 1|| ; inline