some minor bson performance improvements

diff --git a/extra/bson/reader/reader.factor b/extra/bson/reader/reader.factor
index e6ae0060b67ac9fd7a5e7a08509875b325f14691..51aa5f3817e32bba1208090fc7e256858ad58203 100644 (file)
--- a/extra/bson/reader/reader.factor
+++ b/extra/bson/reader/reader.factor
@@ -1,6 +1,6 @@
 USING: accessors assocs bson.constants calendar fry io io.binary
 io.encodings io.encodings.utf8 kernel math math.bitwise namespaces
-sequences serialize ;
+sequences serialize locals ;
 
 FROM: kernel.private => declare ;
 FROM: io.encodings.private => (read-until) ;
@@ -62,22 +62,17 @@ GENERIC: element-binary-read ( length type -- object )
 : read-byte ( -- byte )
     read-byte-raw first ; inline
 
-: utf8-read-until ( seps stream encoding -- string/f sep/f )
-    [ { utf8 } declare decode-char dup [ dup rot member? ] [ 2drop f t ] if ]
-    3curry (read-until) ;
-
 : read-cstring ( -- string )
-    "\0" input-stream get utf8 utf8-read-until drop ; inline
+    "\0" read-until drop "" like ; inline
 
 : read-sized-string ( length -- string )
-    drop read-cstring ; inline
+    read 1 head-slice* "" like ; inline
 
 : read-element-type ( -- type )
     read-byte ; inline
 
-: push-element ( type name -- element )
-    element boa
-    [ get-state element>> push ] keep ; inline
+: push-element ( type name -- )
+    element boa get-state element>> push ; inline
 
 : pop-element ( -- element )
     get-state element>> pop ; inline
@@ -96,8 +91,7 @@ M: bson-object fix-result ( assoc type -- result )
     drop ;
 
 M: bson-array fix-result ( assoc type -- result )
-    drop
-    values ;
+    drop values ;
 
 GENERIC: end-element ( type -- )
 
@@ -108,25 +102,20 @@ M: bson-array end-element ( type -- )
     drop ;
 
 M: object end-element ( type -- )
-    drop
-    pop-element drop ;
+    pop-element 2drop ;
 
-M: bson-eoo element-read ( type -- cont? )
-    drop
-    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 ;
-
-M: bson-not-eoo element-read ( type -- cont? )
-    [ peek-scope ] dip                                 ! scope type 
-    '[ _ read-cstring push-element [ name>> ] [ type>> ] bi 
-       [ element-data-read ] keep
-       end-element
-       swap
-    ] dip set-at t ;
+M:: bson-eoo element-read ( type -- cont? )
+    pop-element :> element
+    get-state scope>>
+    [ pop element type>> fix-result ] [ empty? ] bi
+    [ [ get-state ] dip >>result drop f ]
+    [ element name>> peek-scope set-at t ] if ;
+
+M:: bson-not-eoo element-read ( type -- cont? )
+    peek-scope :> scope
+    type read-cstring [ push-element ] 2keep
+    [ [ element-data-read ] [ end-element ] bi ]
+    [ scope set-at t ] bi* ;
 
 : [scope-changer] ( state -- state quot )
     dup exemplar>> '[ [ [ _ clone ] dip push ] keep ] ; inline
@@ -173,8 +162,7 @@ M: bson-regexp element-data-read ( type -- mdbregexp )
    read-cstring >>regexp read-cstring >>options ;
  
 M: bson-null element-data-read ( type -- bf  )
-    drop
-    f ;
+    drop f ;
 
 M: bson-oid element-data-read ( type -- oid )
     drop

diff --git a/extra/bson/writer/writer.factor b/extra/bson/writer/writer.factor
index f9bd0eb392a45a3980c4454dfcd124776554151f..a07057994331203de6b0101b8f44cdc3539e0a10 100644 (file)
--- a/extra/bson/writer/writer.factor
+++ b/extra/bson/writer/writer.factor
@@ -73,11 +73,9 @@ M: word bson-type? ( word -- type ) drop T_Binary ;
 M: quotation bson-type? ( quotation -- type ) drop T_Binary ; 
 M: byte-array bson-type? ( byte-array -- type ) drop T_Binary ; 
 
-: write-utf8-string ( string -- ) output-stream get '[ _ swap char>utf8 ] each ; inline
-
 : write-int32 ( int -- ) INT32-SIZE >le write ; inline
 : write-double ( real -- ) double>bits INT64-SIZE >le write ; inline
-: write-cstring ( string -- ) write-utf8-string 0 write1 ; inline
+: write-cstring ( string -- ) B{ } like write 0 write1 ; inline
 : write-longlong ( object -- ) INT64-SIZE >le write ; inline
 
 : write-eoo ( -- ) T_EOO write1 ; inline
@@ -127,9 +125,11 @@ M: sequence bson-write ( array -- )
    { $[ MDB_OID_FIELD MDB_META_FIELD ] } member? ; inline
 
 M: assoc bson-write ( assoc -- )
-    '[ _  [ write-oid ] keep
-       [ over skip-field? [ 2drop ] [ write-pair ] if ] assoc-each
-       write-eoo ] with-length-prefix ; 
+    '[
+        _  [ write-oid ] keep
+        [ over skip-field? [ 2drop ] [ write-pair ] if ] assoc-each
+        write-eoo
+    ] with-length-prefix ;
 
 : (serialize-code) ( code -- )
     object>bytes [ length write-int32 ] keep