diff --git a/extra/bson/reader/reader.factor b/extra/bson/reader/reader.factor index 236de63b78..39cd5a9c93 100644 --- a/extra/bson/reader/reader.factor +++ b/extra/bson/reader/reader.factor @@ -2,10 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs bson.constants calendar combinators combinators.short-circuit io io.binary kernel math -namespaces sequences serialize strings vectors ; +namespaces sequences serialize strings vectors byte-arrays ; FROM: io.encodings.binary => binary ; FROM: io.streams.byte-array => with-byte-reader ; +FROM: typed => TYPED: ; IN: bson.reader @@ -20,7 +21,7 @@ TUPLE: state { scope vector } { elements vector } ; -: (prepare-elements) ( -- elements-vector ) +TYPED: (prepare-elements) ( -- elements-vector: vector ) V{ } clone [ T_Object "" element boa swap push ] [ ] bi ; inline : ( exemplar -- state ) @@ -32,37 +33,37 @@ TUPLE: state } cleave (prepare-elements) >>elements ; -: get-state ( -- state ) +TYPED: get-state ( -- state: state ) state get ; inline -: read-int32 ( -- int32 ) +TYPED: read-int32 ( -- int32: integer ) 4 read signed-le> ; inline -: read-longlong ( -- longlong ) +TYPED: read-longlong ( -- longlong: integer ) 8 read signed-le> ; inline -: read-double ( -- double ) +TYPED: read-double ( -- double: float ) 8 read le> bits>double ; inline -: read-byte-raw ( -- byte-raw ) +TYPED: read-byte-raw ( -- byte-raw: byte-array ) 1 read ; inline -: read-byte ( -- byte ) +TYPED: read-byte ( -- byte: integer ) read-byte-raw first ; inline -: read-cstring ( -- string ) +TYPED: read-cstring ( -- string: string ) "\0" read-until drop >string ; inline -: read-sized-string ( length -- string ) +TYPED: read-sized-string ( length: integer -- string: string ) read 1 head-slice* >string ; inline -: push-element ( type name state -- ) +TYPED: push-element ( type: integer name: string state: state -- ) [ element boa ] dip elements>> push ; inline -: pop-element ( state -- element ) +TYPED: pop-element ( state: state -- element: element ) elements>> pop ; inline -: peek-scope ( state -- ht ) +TYPED: peek-scope ( state: state -- ht ) scope>> last ; inline : bson-object-data-read ( -- object ) @@ -70,9 +71,6 @@ TUPLE: state [ exemplar>> clone ] [ scope>> ] bi [ push ] keep ; inline -: bson-binary-bytes? ( subtype -- ? ) - T_Binary_Bytes = ; inline - : bson-binary-read ( -- binary ) read-int32 read-byte { @@ -82,14 +80,14 @@ TUPLE: state [ drop read >string ] } case ; inline -: bson-regexp-read ( -- mdbregexp ) +TYPED: bson-regexp-read ( -- mdbregexp: mdbregexp ) mdbregexp new read-cstring >>regexp read-cstring >>options ; inline -: bson-oid-read ( -- oid ) +TYPED: bson-oid-read ( -- oid: oid ) read-longlong read-int32 oid boa ; inline -: element-data-read ( type -- object ) +TYPED: element-data-read ( type: integer -- object ) { { T_OID [ bson-oid-read ] } { T_String [ read-int32 read-sized-string ] } @@ -104,50 +102,50 @@ TUPLE: state { T_NULL [ f ] } } case ; inline -: bson-array? ( type -- ? ) +TYPED: bson-array? ( type: integer -- ?: boolean ) T_Array = ; inline -: bson-object? ( type -- ? ) +TYPED: bson-object? ( type: integer -- ?: boolean ) T_Object = ; inline : check-object ( assoc -- object ) dup dbref-assoc? [ assoc>dbref ] when ; inline -: fix-result ( assoc type -- result ) +TYPED: fix-result ( assoc type: integer -- result ) { { T_Array [ values ] } { T_Object [ check-object ] } } case ; inline -: end-element ( type -- ) +TYPED: end-element ( type: integer -- ) { [ bson-object? ] [ bson-array? ] } 1|| [ get-state pop-element drop ] unless ; inline -: (>state<) ( -- state scope element ) +TYPED: (>state<) ( -- state: state scope: vector element: element ) get-state [ ] [ scope>> ] [ pop-element ] tri ; inline -: (prepare-result) ( scope element -- result ) +TYPED: (prepare-result) ( scope: vector element: element -- result ) [ pop ] [ type>> ] bi* fix-result ; inline -: bson-eoo-element-read ( -- cont? ) +: bson-eoo-element-read ( -- cont?: boolean ) (>state<) [ (prepare-result) ] [ ] [ drop empty? ] 2tri [ 2drop >>result drop f ] [ swap [ name>> ] [ last ] bi* set-at drop t ] if ; inline -: (prepare-object) ( type -- object ) +TYPED: (prepare-object) ( type: integer -- object ) [ element-data-read ] [ end-element ] bi ; inline -: (read-object) ( type name state -- ) +TYPED: (read-object) ( type: integer name: string state: state -- ) [ (prepare-object) ] 2dip peek-scope set-at ; inline -: bson-not-eoo-element-read ( type -- cont? ) +TYPED: bson-not-eoo-element-read ( type: integer -- cont?: boolean ) read-cstring get-state [ push-element ] [ (read-object) t ] 3bi ; inline -: (element-read) ( type -- cont? ) +TYPED: (element-read) ( type: integer -- cont?: boolean ) dup T_EOO > [ bson-not-eoo-element-read ] [ drop bson-eoo-element-read ] if ; inline diff --git a/extra/bson/writer/writer.factor b/extra/bson/writer/writer.factor index c489c2add2..ffe3d44577 100644 --- a/extra/bson/writer/writer.factor +++ b/extra/bson/writer/writer.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs bson.constants byte-arrays calendar combinators.short-circuit fry hashtables io io.binary -kernel linked-assocs literals math math.parser namespaces +kernel linked-assocs literals math math.parser namespaces byte-vectors quotations sequences serialize strings vectors dlists alien.accessors ; FROM: words => word? word ; FROM: typed => TYPED: ; @@ -17,7 +17,7 @@ CONSTANT: INT64-SIZE 8 PRIVATE> -: with-length ( quot: ( -- ) -- bytes-written start-index ) +TYPED: with-length ( quot -- bytes-written: integer start-index: integer ) [ output-stream get [ length ] [ ] bi ] dip call length swap [ - ] keep ; inline @@ -33,26 +33,26 @@ PRIVATE> le write ; inline +TYPED: write-int32 ( int: integer -- ) INT32-SIZE >le write ; inline -: write-double ( real -- ) double>bits INT64-SIZE >le write ; inline +TYPED: write-double ( real: float -- ) double>bits INT64-SIZE >le write ; inline -: write-cstring ( string -- ) B{ } like write 0 write1 ; inline +TYPED: write-cstring ( string: string -- ) B{ } like write 0 write1 ; inline : write-longlong ( object -- ) INT64-SIZE >le write ; inline : write-eoo ( -- ) T_EOO write1 ; inline -: write-header ( name object type -- object ) +TYPED: write-header ( name: string object type: integer -- object ) write1 [ write-cstring ] dip ; inline DEFER: write-pair -: write-byte-array ( binary -- ) +TYPED: write-byte-array ( binary: byte-array -- ) [ length write-int32 ] [ T_Binary_Bytes write1 write ] bi ; inline -: write-mdbregexp ( regexp -- ) +TYPED: write-mdbregexp ( regexp: mdbregexp -- ) [ regexp>> write-cstring ] [ options>> write-cstring ] bi ; inline @@ -94,7 +94,7 @@ TYPED: write-string ( string: string -- ) TYPED: write-boolean ( bool: boolean -- ) [ 1 write1 ] [ 0 write1 ] if ; inline -: write-pair ( name obj -- ) +TYPED: write-pair ( name: string obj -- ) { { [ dup { [ hashtable? ] [ linked-assoc? ] } 1|| ] @@ -143,12 +143,12 @@ TYPED: write-boolean ( bool: boolean -- ) PRIVATE> -TYPED: assoc>bv ( assoc: hashtables -- byte-vector ) +TYPED: assoc>bv ( assoc: hashtables -- byte-vector: byte-vector ) [ BV{ } clone dup ] dip '[ _ write-assoc ] with-output-stream* ; inline TYPED: assoc>stream ( assoc: hashtables -- ) write-assoc ; inline -: mdb-special-value? ( value -- ? ) +TYPED: mdb-special-value? ( value -- ?: boolean ) { [ timestamp? ] [ quotation? ] [ mdbregexp? ] - [ oid? ] [ byte-array? ] } 1|| ; inline + [ oid? ] [ byte-array? ] } 1|| ; inline \ No newline at end of file