steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

removed locals usage & dead code

db4
Sascha Matzke 2010-02-28 11:41:15 +01:00
parent faf4d2372c
commit 56cbc62b74
2 changed files with 79 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

140
extra/bson/reader/reader.factor
View File

@ -1,44 +1,36 @@
! Copyright (C) 2010 Sascha Matzke. ! Copyright (C) 2010 Sascha Matzke.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs bson.constants calendar combinators USING: accessors assocs bson.constants calendar combinators
combinators.short-circuit fry io io.binary kernel locals math combinators.short-circuit io io.binary kernel math
namespaces sequences serialize tools.continuations strings ; namespaces sequences serialize strings vectors ;
FROM: io.encodings.binary => binary ; FROM: io.encodings.binary => binary ;
FROM: io.streams.byte-array => with-byte-reader ; FROM: io.streams.byte-array => with-byte-reader ;
IN: bson.reader IN: bson.reader
<PRIVATE <PRIVATE
TUPLE: element { type integer } name ; TUPLE: element { type integer } name ;
TUPLE: state TUPLE: state
{ size initial: -1 } exemplar { size initial: -1 }
result scope element ; { exemplar assoc }
result
{ scope vector }
{ elements vector } ;
: (prepare-elements) ( -- elements-vector )
V{ } clone [ T_Object "" element boa swap push ] [ ] bi ; inline
: <state> ( exemplar -- state ) : <state> ( exemplar -- state )
[ state new ] dip [ state new ] dip
[ clone >>exemplar ] keep {
clone [ >>result ] [ V{ } clone [ push ] keep >>scope ] bi [ clone >>exemplar ]
V{ } clone [ T_Object "" element boa swap push ] keep >>element ; [ clone >>result ]
[ V{ } clone [ push ] keep >>scope ]
PREDICATE: bson-not-eoo < integer T_EOO > ; } cleave
PREDICATE: bson-eoo < integer T_EOO = ; (prepare-elements) >>elements ;
PREDICATE: bson-string < integer T_String = ;
PREDICATE: bson-object < integer T_Object = ;
PREDICATE: bson-oid < integer T_OID = ;
PREDICATE: bson-array < integer T_Array = ;
PREDICATE: bson-integer < integer T_Integer = ;
PREDICATE: bson-double < integer T_Double = ;
PREDICATE: bson-date < integer T_Date = ;
PREDICATE: bson-binary < integer T_Binary = ;
PREDICATE: bson-boolean < integer T_Boolean = ;
PREDICATE: bson-regexp < integer T_Regexp = ;
PREDICATE: bson-null < integer T_NULL = ;
PREDICATE: bson-ref < integer T_DBRef = ;
PREDICATE: bson-binary-bytes < integer T_Binary_Bytes = ;
PREDICATE: bson-binary-function < integer T_Binary_Function = ;
PREDICATE: bson-binary-uuid < integer T_Binary_UUID = ;
PREDICATE: bson-binary-custom < integer T_Binary_Custom = ;
: get-state ( -- state ) : get-state ( -- state )
state get ; inline state get ; inline
@ -53,7 +45,7 @@ PREDICATE: bson-binary-custom < integer T_Binary_Custom = ;
8 read le> bits>double ; inline 8 read le> bits>double ; inline
: read-byte-raw ( -- byte-raw ) : read-byte-raw ( -- byte-raw )
1 read ; 1 read ; inline
: read-byte ( -- byte ) : read-byte ( -- byte )
read-byte-raw first ; inline read-byte-raw first ; inline
@ -64,26 +56,31 @@ PREDICATE: bson-binary-custom < integer T_Binary_Custom = ;
: read-sized-string ( length -- string ) : read-sized-string ( length -- string )
read 1 head-slice* >string ; inline read 1 head-slice* >string ; inline
: read-element-type ( -- type ) : push-element ( type name state -- )
read-byte ; inline [ element boa ] dip elements>> push ; inline
: push-element ( type name -- ) : pop-element ( state -- element )
element boa get-state element>> push ; inline elements>> pop ; inline
: pop-element ( -- element ) : peek-scope ( state -- ht )
get-state element>> pop ; inline scope>> last ; inline
: peek-scope ( -- ht )
get-state scope>> last ; inline
: bson-object-data-read ( -- object ) : bson-object-data-read ( -- object )
read-int32 drop get-state read-int32 drop get-state
[ exemplar>> clone ] [ scope>> ] bi [ exemplar>> clone ] [ scope>> ] bi
[ push ] keep ; inline [ push ] keep ; inline
: bson-binary-bytes? ( subtype -- ? )
T_Binary_Bytes = ; inline
: bson-binary-read ( -- binary ) : bson-binary-read ( -- binary )
read-int32 read-byte read-int32 read-byte
bson-binary-bytes? [ read ] [ read bytes>object ] if ; inline {
{ T_Binary_Bytes [ read ] }
{ T_Binary_Custom [ read bytes>object ] }
{ T_Binary_Function [ read ] }
[ drop read >string ]
} case ; inline
: bson-regexp-read ( -- mdbregexp ) : bson-regexp-read ( -- mdbregexp )
mdbregexp new mdbregexp new
@ -107,44 +104,61 @@ PREDICATE: bson-binary-custom < integer T_Binary_Custom = ;
{ T_NULL [ f ] } { T_NULL [ f ] }
} case ; inline } case ; inline
: bson-array? ( type -- ? )
T_Array = ; inline
: bson-object? ( type -- ? )
T_Object = ; inline
: check-object ( assoc -- object )
dup dbref-assoc? [ assoc>dbref ] when ; inline
: fix-result ( assoc type -- result ) : fix-result ( assoc type -- result )
{ {
{ [ dup T_Array = ] [ drop values ] } { T_Array [ values ] }
{ { T_Object [ check-object ] }
[ dup T_Object = ] } case ; inline
[ drop dup dbref-assoc? [ assoc>dbref ] when ]
}
} cond ; inline
: end-element ( type -- ) : end-element ( type -- )
{ [ bson-object? ] [ bson-array? ] } 1|| { [ bson-object? ] [ bson-array? ] } 1||
[ pop-element drop ] unless ; inline [ get-state pop-element drop ] unless ; inline
:: bson-eoo-element-read ( type -- cont? ) : (>state<) ( -- state scope element )
pop-element :> element get-state [ ] [ scope>> ] [ pop-element ] tri ; inline
get-state scope>>
[ pop element type>> fix-result ] [ empty? ] bi
[ [ get-state ] dip >>result drop f ]
[ element name>> peek-scope set-at t ] if ; inline
:: bson-not-eoo-element-read ( type -- cont? ) : (prepare-result) ( scope element -- result )
peek-scope :> scope [ pop ] [ type>> ] bi* fix-result ; inline
type read-cstring [ push-element ] 2keep
[ [ element-data-read ] [ end-element ] bi ] : bson-eoo-element-read ( -- cont? )
[ scope set-at t ] bi* ; inline (>state<)
[ (prepare-result) ] [ ] [ drop empty? ] 2tri
[ 2drop >>result drop f ]
[ swap [ name>> ] [ last ] bi* set-at drop t ] if ; inline
: (prepare-object) ( type -- object )
[ element-data-read ] [ end-element ] bi ; inline
: (read-object) ( type name state -- )
[ (prepare-object) ] 2dip
peek-scope set-at ; inline
: bson-not-eoo-element-read ( type -- cont? )
read-cstring get-state
[ push-element ]
[ (read-object) t ] 3bi ; inline
: (element-read) ( type -- cont? ) : (element-read) ( type -- cont? )
dup bson-not-eoo? dup T_EOO >
[ bson-not-eoo-element-read ] [ bson-not-eoo-element-read ]
[ bson-eoo-element-read ] if ; inline [ drop bson-eoo-element-read ] if ; inline
: read-elements ( -- ) : read-elements ( -- )
read-element-type read-byte (element-read)
(element-read) [ read-elements ] when ; inline recursive [ read-elements ] when ; inline recursive
PRIVATE> PRIVATE>
: stream>assoc ( exemplar -- assoc ) : stream>assoc ( exemplar -- assoc )
<state> dup state <state> read-int32 >>size
[ read-int32 >>size read-elements ] with-variable [ state [ read-elements ] with-variable ]
result>> ; inline [ result>> ] bi ;

4
extra/bson/writer/writer.factor
View File

@ -84,7 +84,7 @@ TYPED: write-assoc ( assoc: hashtables -- )
UNION: code word quotation ; UNION: code word quotation ;
TYPED: (serialize-code) ( code: code -- ) TYPED: (serialize-code) ( code: code -- )
object>bytes object>bytes
[ length write-int32 ] [ length write-int32 ]
[ T_Binary_Custom write1 write ] bi ; inline [ T_Binary_Custom write1 write ] bi ; inline
@ -144,7 +144,7 @@ TYPED: write-boolean ( bool: boolean -- )
PRIVATE> PRIVATE>
TYPED: assoc>bv ( assoc: hashtables -- byte-vector ) TYPED: assoc>bv ( assoc: hashtables -- byte-vector )
[ BV{ } clone dup ] dip '[ _ write-assoc ] with-output-stream* ; inline [ BV{ } clone dup ] dip '[ _ write-assoc ] with-output-stream* ; inline
TYPED: assoc>stream ( assoc: hashtables -- ) TYPED: assoc>stream ( assoc: hashtables -- )
write-assoc ; inline write-assoc ; inline