changed type > byte-array conversion; now using io.binary (>le, le>)
updated USING:sdb4
parent
16965933bc
commit
2e641216f3
|
@ -1,5 +1,4 @@
|
||||||
USING: alien.c-types accessors kernel calendar random math.bitwise math unix
|
USING: accessors constructors uuid ;
|
||||||
constructors uuid ;
|
|
||||||
|
|
||||||
IN: bson.constants
|
IN: bson.constants
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
USING: mirrors io io.encodings.utf8 io.encodings.binary math kernel sequences
|
USING: accessors assocs bson.constants byte-arrays byte-vectors fry io
|
||||||
splitting accessors io.streams.byte-array namespaces prettyprint
|
io.binary io.encodings.string io.encodings.utf8 kernel math namespaces
|
||||||
bson.constants assocs alien.c-types alien.strings fry words
|
sequences serialize ;
|
||||||
serialize byte-arrays byte-vectors ;
|
|
||||||
|
|
||||||
IN: bson.reader
|
IN: bson.reader
|
||||||
|
|
||||||
|
@ -48,19 +47,19 @@ GENERIC: element-binary-read ( length type -- object )
|
||||||
[ get-state ] dip '[ _ + ] change-read drop ; inline
|
[ get-state ] dip '[ _ + ] change-read drop ; inline
|
||||||
|
|
||||||
: read-int32 ( -- int32 )
|
: read-int32 ( -- int32 )
|
||||||
4 [ read *int ] [ count-bytes ] bi ; inline
|
4 [ read le> ] [ count-bytes ] bi ; inline
|
||||||
|
|
||||||
: read-longlong ( -- longlong )
|
: read-longlong ( -- longlong )
|
||||||
8 [ read *longlong ] [ count-bytes ] bi ; inline
|
8 [ read le> ] [ count-bytes ] bi ; inline
|
||||||
|
|
||||||
: read-double ( -- double )
|
: read-double ( -- double )
|
||||||
8 [ read *double ] [ count-bytes ] bi ; inline
|
8 [ read le> bits>double ] [ count-bytes ] bi ; inline
|
||||||
|
|
||||||
: read-byte-raw ( -- byte-raw )
|
: read-byte-raw ( -- byte-raw )
|
||||||
1 [ read ] [ count-bytes ] bi ; inline
|
1 [ read ] [ count-bytes ] bi ; inline
|
||||||
|
|
||||||
: read-byte ( -- byte )
|
: read-byte ( -- byte )
|
||||||
read-byte-raw *char ; inline
|
read-byte-raw first ; inline
|
||||||
|
|
||||||
: (read-cstring) ( acc -- )
|
: (read-cstring) ( acc -- )
|
||||||
[ read-byte-raw first ] dip ! b acc
|
[ read-byte-raw first ] dip ! b acc
|
||||||
|
@ -71,11 +70,12 @@ GENERIC: element-binary-read ( length type -- object )
|
||||||
: read-cstring ( -- string )
|
: read-cstring ( -- string )
|
||||||
BV{ } clone
|
BV{ } clone
|
||||||
[ (read-cstring) ] keep
|
[ (read-cstring) ] keep
|
||||||
>byte-array utf8 alien>string ; inline
|
[ zero? ] trim-tail
|
||||||
|
>byte-array utf8 decode ; inline
|
||||||
|
|
||||||
: read-sized-string ( length -- string )
|
: read-sized-string ( length -- string )
|
||||||
[ read ] [ count-bytes ] bi
|
[ read ] [ count-bytes ] bi
|
||||||
utf8 alien>string ; inline
|
[ zero? ] trim-tail utf8 decode ; inline
|
||||||
|
|
||||||
: read-element-type ( -- type )
|
: read-element-type ( -- type )
|
||||||
read-byte ; inline
|
read-byte ; inline
|
||||||
|
|
|
@ -1,11 +1,9 @@
|
||||||
! Copyright (C) 2008 Sascha Matzke.
|
! Copyright (C) 2008 Sascha Matzke.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: bson bson.constants accessors kernel io.streams.string
|
USING: accessors assocs bson.constants byte-arrays fry io io.binary
|
||||||
io.encodings.binary classes byte-arrays quotations serialize
|
io.encodings.binary io.encodings.string io.encodings.utf8
|
||||||
io.encodings.utf8 strings splitting math.parser
|
io.streams.byte-array kernel math math.parser quotations sequences
|
||||||
sequences math assocs classes words make fry
|
serialize strings words ;
|
||||||
prettyprint hashtables mirrors alien.strings alien.c-types
|
|
||||||
io.streams.byte-array io alien.strings ;
|
|
||||||
|
|
||||||
IN: bson.writer
|
IN: bson.writer
|
||||||
|
|
||||||
|
@ -32,11 +30,11 @@ M: objref bson-type? ( objref -- 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 ;
|
||||||
|
|
||||||
: write-byte ( byte -- ) <char> write ; inline
|
: write-byte ( byte -- ) 1 >le write ; inline
|
||||||
: write-int32 ( int -- ) <int> write ; inline
|
: write-int32 ( int -- ) 4 >le write ; inline
|
||||||
: write-double ( real -- ) <double> write ; inline
|
: write-double ( real -- ) double>bits 8 >le write ; inline
|
||||||
: write-cstring ( string -- ) utf8 string>alien write ; inline
|
: write-cstring ( string -- ) utf8 encode B{ 0 } append write ; inline
|
||||||
: write-longlong ( object -- ) <longlong> write ; inline
|
: write-longlong ( object -- ) 8 >le write ; inline
|
||||||
|
|
||||||
: write-eoo ( -- ) T_EOO write-byte ; inline
|
: write-eoo ( -- ) T_EOO write-byte ; inline
|
||||||
: write-type ( obj -- obj ) [ bson-type? write-byte ] keep ; inline
|
: write-type ( obj -- obj ) [ bson-type? write-byte ] keep ; inline
|
||||||
|
@ -50,7 +48,7 @@ M: t bson-write ( t -- )
|
||||||
drop 1 write-byte ;
|
drop 1 write-byte ;
|
||||||
|
|
||||||
M: string bson-write ( obj -- )
|
M: string bson-write ( obj -- )
|
||||||
utf8 string>alien
|
utf8 encode B{ 0 } append
|
||||||
[ length write-int32 ] keep
|
[ length write-int32 ] keep
|
||||||
write ;
|
write ;
|
||||||
|
|
||||||
|
@ -71,14 +69,14 @@ M: quotation bson-write ( quotation -- )
|
||||||
write ;
|
write ;
|
||||||
|
|
||||||
M: objid bson-write ( oid -- )
|
M: objid bson-write ( oid -- )
|
||||||
id>> utf8 string>alien
|
id>> utf8 encode
|
||||||
[ length write-int32 ] keep
|
[ length write-int32 ] keep
|
||||||
T_Binary_UUID write-byte
|
T_Binary_UUID write-byte
|
||||||
write ;
|
write ;
|
||||||
|
|
||||||
M: objref bson-write ( objref -- )
|
M: objref bson-write ( objref -- )
|
||||||
[ ns>> utf8 string>alien ]
|
[ ns>> utf8 encode ]
|
||||||
[ objid>> id>> utf8 string>alien ] bi
|
[ objid>> id>> utf8 encode ] bi
|
||||||
append
|
append
|
||||||
[ length write-int32 ] keep
|
[ length write-int32 ] keep
|
||||||
T_Binary_Custom write-byte
|
T_Binary_Custom write-byte
|
||||||
|
|
|
@ -10,6 +10,7 @@ GENERIC: store ( tuple/ht -- )
|
||||||
GENERIC: find ( example -- tuple/ht )
|
GENERIC: find ( example -- tuple/ht )
|
||||||
GENERIC# nfind 1 ( example n -- tuple/ht )
|
GENERIC# nfind 1 ( example n -- tuple/ht )
|
||||||
GENERIC: load ( object -- object )
|
GENERIC: load ( object -- object )
|
||||||
|
GENERIC: explain ( object -- object )
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
@ -39,4 +40,7 @@ M: mdb-persistent nfind ( example n -- result )
|
||||||
[ mdb>> master>> ] dip (find)
|
[ mdb>> master>> ] dip (find)
|
||||||
build-result ;
|
build-result ;
|
||||||
|
|
||||||
|
M: mdb-persistent explain ( example -- result )
|
||||||
|
prepare-find [ query>> [ t "$explain" ] dip set-at ] keep
|
||||||
|
[ mdb>> master>> ] dip (find-one)
|
||||||
|
build-result ;
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: accessors alien.c-types alien.strings assocs bson.reader
|
USING: accessors io.encodings.string assocs bson.reader
|
||||||
bson.writer byte-arrays byte-vectors constructors fry io
|
bson.writer byte-arrays byte-vectors constructors fry io io.binary
|
||||||
io.encodings.binary io.encodings.utf8 io.streams.byte-array kernel
|
io.encodings.binary io.encodings.utf8 io.streams.byte-array kernel
|
||||||
linked-assocs math namespaces sequences strings ;
|
linked-assocs math namespaces sequences strings ;
|
||||||
|
|
||||||
|
@ -126,15 +126,15 @@ SYMBOL: msg-bytes-read
|
||||||
: change-bytes-read ( integer -- )
|
: change-bytes-read ( integer -- )
|
||||||
bytes-read> [ 0 ] unless* + >bytes-read ; inline
|
bytes-read> [ 0 ] unless* + >bytes-read ; inline
|
||||||
|
|
||||||
: write-byte ( byte -- ) <char> write ; inline
|
: write-byte ( byte -- ) 1 >le write ; inline
|
||||||
: write-int32 ( int -- ) <int> write ; inline
|
: write-int32 ( int -- ) 4 >le write ; inline
|
||||||
: write-double ( real -- ) <double> write ; inline
|
: write-double ( real -- ) double>bits 8 >le write ; inline
|
||||||
: write-cstring ( string -- ) utf8 string>alien write ; inline
|
: write-cstring ( string -- ) utf8 encode B{ 0 } append write ; inline
|
||||||
: write-longlong ( object -- ) <longlong> write ; inline
|
: write-longlong ( object -- ) 8 >le write ; inline
|
||||||
|
|
||||||
: read-int32 ( -- int32 ) 4 [ read *int ] [ change-bytes-read ] bi ; inline
|
: read-int32 ( -- int32 ) 4 [ read le> ] [ change-bytes-read ] bi ; inline
|
||||||
: read-longlong ( -- longlong ) 8 [ read *longlong ] [ change-bytes-read ] bi ; inline
|
: read-longlong ( -- longlong ) 8 [ read le> ] [ change-bytes-read ] bi ; inline
|
||||||
: read-byte-raw ( -- byte-raw ) 1 [ read ] [ change-bytes-read ] bi ; inline
|
: read-byte-raw ( -- byte-raw ) 1 [ read le> ] [ change-bytes-read ] bi ; inline
|
||||||
: read-byte ( -- byte ) read-byte-raw first ; inline
|
: read-byte ( -- byte ) read-byte-raw first ; inline
|
||||||
|
|
||||||
: (read-cstring) ( acc -- )
|
: (read-cstring) ( acc -- )
|
||||||
|
@ -146,7 +146,8 @@ SYMBOL: msg-bytes-read
|
||||||
: read-cstring ( -- string )
|
: read-cstring ( -- string )
|
||||||
BV{ } clone
|
BV{ } clone
|
||||||
[ (read-cstring) ] keep
|
[ (read-cstring) ] keep
|
||||||
>byte-array utf8 alien>string ; inline
|
[ zero? ] trim-tail
|
||||||
|
>byte-array utf8 decode ; inline
|
||||||
|
|
||||||
GENERIC: (read-message) ( message opcode -- message )
|
GENERIC: (read-message) ( message opcode -- message )
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue