diff --git a/bson/bson.factor b/bson/bson.factor new file mode 100644 index 0000000000..4be8e2d3ed --- /dev/null +++ b/bson/bson.factor @@ -0,0 +1,9 @@ + +IN: bson + +USE: vocabs.loader + +SINGLETON: bson-null + +"bson.reader" require +"bson.writer" require diff --git a/mongodb/bson/constants/constants.factor b/bson/constants/constants.factor similarity index 58% rename from mongodb/bson/constants/constants.factor rename to bson/constants/constants.factor index 80e9933740..f519c0f998 100644 --- a/mongodb/bson/constants/constants.factor +++ b/bson/constants/constants.factor @@ -1,6 +1,8 @@ USING: alien.c-types ; -IN: mongodb.bson.constants +IN: bson.constants + +TUPLE: oid { a initial: 0 } { b initial: 0 } ; : T_EOO ( -- type ) 0 ; inline @@ -26,32 +28,4 @@ IN: mongodb.bson.constants : T_Binary_Bytes ( -- subtype ) 2 ; inline : T_Binary_Function ( -- subtype ) 1 ; inline -: S_Name ( -- name ) "__t_name" ; inline -: S_Vocab ( -- name ) "__t_vocab" ; inline -! todo Move to mongo vocab - -: OP_Reply ( -- const ) - 1 ; inline - -: OP_Message ( -- const ) - 1000 ; inline - -: OP_Update ( -- const ) - 2001 ; inline - -: OP_Insert ( -- const ) - 2002 ; inline - -: OP_Query ( -- const ) - 2004 ; inline - -: OP_GetMore ( -- const ) - 2005 ; inline - -: OP_Delete ( -- const ) - 2006 ; inline - -: OP_KillCursors ( -- const ) - 2007 ; inline - \ No newline at end of file diff --git a/mongodb/bson/reader/reader.factor b/bson/reader/reader.factor similarity index 71% rename from mongodb/bson/reader/reader.factor rename to bson/reader/reader.factor index 276acc1263..b7ef83d80e 100644 --- a/mongodb/bson/reader/reader.factor +++ b/bson/reader/reader.factor @@ -1,21 +1,22 @@ USING: mirrors io io.encodings.utf8 io.encodings.binary math match kernel sequences splitting accessors io.streams.byte-array namespaces prettyprint - mongodb.bson.constants assocs alien.c-types alien.strings fry words - tools.walker serialize mongodb.persistent ; + bson.constants assocs alien.c-types alien.strings fry words + tools.walker serialize locals byte-arrays ; -IN: mongodb.bson.reader +IN: bson.reader ERROR: size-mismatch actual declared ; ( -- state ) - state new H{ } clone - [ >>result ] [ V{ } clone [ push ] keep >>scope ] bi - V{ } clone [ T_Object "" element boa swap push ] keep >>element ; +:: ( exemplar -- state ) + state new + exemplar clone >>exemplar + exemplar clone [ >>result ] [ V{ } clone [ push ] keep >>scope ] bi + V{ } clone [ T_Object "" element boa swap push ] keep >>element ; inline PREDICATE: bson-eoo < integer T_EOO = ; PREDICATE: bson-not-eoo < integer T_EOO > ; @@ -63,45 +64,38 @@ GENERIC: element-binary-read ( length type -- object ) read-byte-raw dup B{ 0 } = [ append ] - [ append (read-cstring) ] if ; + [ append (read-cstring) ] if ; inline recursive : read-cstring ( -- string ) B{ } clone - (read-cstring) utf8 alien>string ; + (read-cstring) utf8 alien>string ; inline : read-sized-string ( length -- string ) [ read ] [ count-bytes ] bi - utf8 alien>string ; + utf8 alien>string ; inline : read-element-type ( -- type ) - read-byte ; + read-byte ; inline : push-element ( type name -- element ) element boa - [ get-state element>> push ] keep ; + [ get-state element>> push ] keep ; inline : pop-element ( -- element ) - get-state element>> pop ; + get-state element>> pop ; inline : peek-scope ( -- ht ) - get-state scope>> peek ; + get-state scope>> peek ; inline : read-elements ( -- ) read-element-type element-read - [ read-elements ] when ; - -: make-tuple ( assoc -- tuple ) - [ P_INFO swap at persistent-tuple-class new ] keep ! instance assoc - [ dup [ keys ] keep ] dip ! instance array mirror assoc - '[ dup _ [ _ at ] dip [ swap ] dip set-at ] each ; + [ read-elements ] when ; inline recursive GENERIC: fix-result ( assoc type -- result ) M: bson-object fix-result ( assoc type -- result ) - drop - [ ] [ P_INFO swap key? ] bi - [ make-tuple ] [ ] if ; + drop ; M: bson-array fix-result ( assoc type -- result ) drop @@ -109,10 +103,10 @@ M: bson-array fix-result ( assoc type -- result ) M: bson-eoo element-read ( type -- cont? ) drop - get-state scope>> [ pop ] keep swap ! vec assoc - pop-element [ type>> ] keep ! vec assoc type element - [ fix-result ] dip ! vec result element - rot length 0 > ! result element + get-state scope>> [ pop ] keep swap ! vec assoc + pop-element [ type>> ] keep ! vec assoc element + [ fix-result ] dip + rot length 0 > ! assoc element [ name>> peek-scope set-at t ] [ drop [ get-state ] dip >>result drop f ] if ; @@ -133,19 +127,21 @@ M: bson-oid element-data-read ( type -- object ) oid boa pop-element drop ; -M: bson-object element-data-read ( type -- object ) - drop - read-int32 drop - get-state - [ [ [ H{ } clone ] dip push ] keep ] change-scope - scope>> peek ; +: [scope-changer] ( state -- state quot ) + dup exemplar>> '[ [ [ _ clone ] dip push ] keep ] ; inline -M: bson-array element-data-read ( type -- object ) +: (object-data-read) ( type -- object ) drop read-int32 drop get-state - [ [ [ H{ } clone ] dip push ] keep ] change-scope - scope>> peek ; + [scope-changer] change-scope + scope>> peek ; inline + +M: bson-object element-data-read ( type -- object ) + (object-data-read) ; + +M: bson-array element-data-read ( type -- object ) + (object-data-read) ; M: bson-string element-data-read ( type -- object ) drop @@ -179,10 +175,18 @@ M: bson-binary-function element-binary-read ( size type -- quot ) drop read bytes>object ; PRIVATE> - -: bson> ( arr -- ht ) - binary - [ dup state + +GENERIC: stream>assoc ( exemplar -- assoc ) + +M: assoc stream>assoc ( exemplar -- assoc ) + dup state [ read-int32 >>size read-elements ] with-variable - result>> - ] with-byte-reader ; + result>> ; + +USING: multi-methods ; + +GENERIC: array>assoc ( array exemplar -- assoc ) + +METHOD: array>assoc { byte-array assoc } ( array exemplar -- assoc ) + [ binary ] dip '[ _ stream>assoc ] with-byte-reader ; + diff --git a/bson/writer/writer.factor b/bson/writer/writer.factor new file mode 100644 index 0000000000..a85a9867c5 --- /dev/null +++ b/bson/writer/writer.factor @@ -0,0 +1,102 @@ +! Copyright (C) 2008 Sascha Matzke. +! See http://factorcode.org/license.txt for BSD license. +USING: bson bson.constants accessors kernel io.streams.string + io.encodings.binary classes byte-arrays quotations serialize + io.encodings.utf8 strings splitting math.parser locals + sequences math assocs classes words make fry + prettyprint hashtables mirrors alien.strings alien.c-types + io.streams.byte-array io ; + +IN: bson.writer + +#! Writes the object out to a stream in BSON format + + write ; inline +: write-int32 ( int -- ) write ; inline +: write-double ( real -- ) write ; inline +: write-cstring ( string -- ) utf8 string>alien write ; inline +: write-longlong ( object -- ) write ; inline + +: write-eoo ( -- ) T_EOO write-byte ; inline +: write-type ( obj -- obj ) [ bson-type? write-byte ] keep ; inline +: write-pair ( name object -- ) write-type [ write-cstring ] dip bson-write ; inline + + +M: f bson-write ( f -- ) + drop 0 write-byte ; + +M: t bson-write ( t -- ) + drop 1 write-byte ; + +M: bson-null bson-write ( null -- ) + drop ; + +M: string bson-write ( obj -- ) + utf8 string>alien + [ length write-int32 ] keep + write ; + +M: integer bson-write ( num -- ) + write-int32 ; + +M: real bson-write ( num -- ) + >float write-double ; + +M: byte-array bson-write ( binary -- ) + [ length write-int32 ] keep + 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: sequence bson-write ( array -- ) + '[ _ [ [ write-type ] dip number>string write-cstring bson-write ] + each-index ] + binary swap with-byte-writer + [ length 5 + bson-write ] keep + write + write-eoo ; + +M: assoc bson-write ( hashtable -- ) + '[ _ [ write-pair ] assoc-each ] + binary swap with-byte-writer + [ length 5 + bson-write ] keep + write + write-eoo ; + +M: word bson-write name>> bson-write ; + +PRIVATE> + +: assoc>array ( assoc -- byte-array ) + '[ _ bson-write ] binary swap with-byte-writer ; inline + +: assoc>stream ( assoc -- ) + bson-write ; inline + diff --git a/mongodb/bson/bson.factor b/mongodb/bson/bson.factor deleted file mode 100644 index 27033094de..0000000000 --- a/mongodb/bson/bson.factor +++ /dev/null @@ -1,9 +0,0 @@ - -IN: mongodb.bson - -USE: vocabs.loader - -SINGLETON: bson-null - -"mongodb.bson.reader" require -"mongodb.bson.writer" require diff --git a/mongodb/bson/writer/writer.factor b/mongodb/bson/writer/writer.factor deleted file mode 100644 index 44dca02991..0000000000 --- a/mongodb/bson/writer/writer.factor +++ /dev/null @@ -1,122 +0,0 @@ -! Copyright (C) 2008 Sascha Matzke. -! See http://factorcode.org/license.txt for BSD license. -USING: mongodb.bson mongodb.bson.constants accessors kernel io.streams.string - io.encodings.binary classes byte-arrays quotations serialize - io.encodings.utf8 strings splitting math.parser locals - sequences math assocs classes words make fry mongodb.persistent - prettyprint hashtables mirrors alien.strings alien.c-types - io.streams.byte-array io ; - -IN: mongodb.bson.writer - -#! Writes the object out to a stream in BSON format - - write ; -: write-int32 ( int -- ) write ; -: write-double ( real -- ) write ; -: write-cstring ( string -- ) utf8 string>alien write ; -: write-longlong ( object -- ) write ; - -: write-eoo ( -- ) T_EOO write-byte ; -: write-type ( obj -- obj ) [ bson-type? write-byte ] keep ; -: write-pair ( name object -- ) write-type [ write-cstring ] dip bson-write ; - -:: write-tuple-info ( object -- ) - P_SLOTS [ [ ] [ object at ] bi write-pair ] each ; - -M: f bson-write ( f -- ) - drop 0 write-byte ; - -M: t bson-write ( t -- ) - drop 1 write-byte ; - -M: bson-null bson-write ( null -- ) - drop ; - -M: string bson-write ( obj -- ) - utf8 string>alien - [ length write-int32 ] keep - write ; - -M: integer bson-write ( num -- ) - write-int32 ; - -M: real bson-write ( num -- ) - >float write-double ; - -M: byte-array bson-write ( binary -- ) - [ length write-int32 ] keep - 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: sequence bson-write ( array -- ) - '[ _ [ [ write-type ] dip number>string write-cstring bson-write ] - each-index ] - binary swap with-byte-writer - [ length 5 + bson-write ] keep - write - write-eoo ; - -: check-p-field ( key value -- key value boolean ) - [ [ "_p_" swap start 0 = ] keep ] dip rot ; - -M: persistent-tuple bson-write ( persistent-tuple -- ) - - '[ _ [ write-tuple-info ] - [ [ check-p-field [ 2drop ] [ write-pair ] if ] assoc-each ] bi ] - binary swap with-byte-writer - [ length 5 + bson-write ] keep - write - write-eoo ; - -M: tuple bson-write ( tuple -- ) - make-persistent bson-write ; - -M: assoc bson-write ( hashtable -- ) - '[ _ [ write-pair ] assoc-each ] - binary swap with-byte-writer - [ length 5 + bson-write ] keep - write - write-eoo ; - -M: word bson-write name>> bson-write ; - -PRIVATE> - -GENERIC: >bson ( obj -- byte-aray ) - -M: tuple >bson ( tuble -- byte-array ) - '[ _ bson-write ] binary swap with-byte-writer ; - -M: hashtable >bson ( hashmap -- byte-array ) - '[ _ bson-write ] binary swap with-byte-writer ; - -