Merge branch 'mongodb-changes' of git://github.com/x6j8x/factor

diff --git a/extra/bson/constants/constants.factor b/extra/bson/constants/constants.factor
index 2d126857c33326a40b3d1c8bd308976a54c3a29e..e4bf14432a14a79c6113e89f1027d96427e038a6 100644 (file)
--- a/extra/bson/constants/constants.factor
+++ b/extra/bson/constants/constants.factor
@@ -19,6 +19,16 @@ TUPLE: oid { a initial: 0 } { b initial: 0 } ;
 
 TUPLE: dbref ref id db ;
 
+TUPLE: mongo-timestamp incr seconds ;
+
+: <mongo-timestamp> ( incr seconds -- mongo-timestamp )
+    mongo-timestamp boa ;
+
+TUPLE: mongo-scoped-code code object ;
+
+: <mongo-scoped-code> ( code object -- mongo-scoped-code )
+    mongo-scoped-code boa ;
+
 CONSTRUCTOR: dbref ( ref id -- dbref ) ;
 
 : dbref>assoc ( dbref -- assoc )
@@ -47,30 +57,31 @@ TUPLE: mdbregexp { regexp string } { options string } ;
 CONSTANT: MDB_OID_FIELD "_id"
 CONSTANT: MDB_META_FIELD "_mfd"
 
-CONSTANT: T_EOO  0  
-CONSTANT: T_Double  1  
-CONSTANT: T_Integer  16  
-CONSTANT: T_Boolean  8  
-CONSTANT: T_String  2  
-CONSTANT: T_Object  3  
-CONSTANT: T_Array  4  
-CONSTANT: T_Binary  5  
-CONSTANT: T_Undefined  6  
-CONSTANT: T_OID  7  
-CONSTANT: T_Date  9  
-CONSTANT: T_NULL  10  
-CONSTANT: T_Regexp  11  
-CONSTANT: T_DBRef  12  
-CONSTANT: T_Code  13  
-CONSTANT: T_ScopedCode  17  
-CONSTANT: T_Symbol  14  
-CONSTANT: T_JSTypeMax  16  
-CONSTANT: T_MaxKey  127  
-
-CONSTANT: T_Binary_Function 1   
-CONSTANT: T_Binary_Bytes 2
-CONSTANT: T_Binary_UUID 3
-CONSTANT: T_Binary_MD5 5
-CONSTANT: T_Binary_Custom 128
-
+CONSTANT: T_EOO     0
+CONSTANT: T_Double  HEX: 1
+CONSTANT: T_String  HEX: 2
+CONSTANT: T_Object  HEX: 3
+CONSTANT: T_Array   HEX: 4
+CONSTANT: T_Binary  HEX: 5
+CONSTANT: T_Undefined  HEX: 6
+CONSTANT: T_OID     HEX: 7
+CONSTANT: T_Boolean HEX: 8
+CONSTANT: T_Date    HEX: 9
+CONSTANT: T_NULL    HEX: A
+CONSTANT: T_Regexp  HEX: B
+CONSTANT: T_DBRef   HEX: C
+CONSTANT: T_Code    HEX: D
+CONSTANT: T_Symbol  HEX: E
+CONSTANT: T_ScopedCode HEX: F
+CONSTANT: T_Integer HEX: 10
+CONSTANT: T_Timestamp HEX: 11
+CONSTANT: T_Integer64 HEX: 12
+CONSTANT: T_MinKey  HEX: FF
+CONSTANT: T_MaxKey  HEX: 7F
+
+CONSTANT: T_Binary_Function     HEX: 1
+CONSTANT: T_Binary_Bytes        HEX: 2
+CONSTANT: T_Binary_UUID         HEX: 3
+CONSTANT: T_Binary_MD5          HEX: 5
+CONSTANT: T_Binary_Custom       HEX: 80
 

diff --git a/extra/bson/reader/reader.factor b/extra/bson/reader/reader.factor
index e0cf0bc4f46c81353cf019931516c0c1167e833b..852f46f951fc750d27a074830936377def6bdb11 100644 (file)
--- a/extra/bson/reader/reader.factor
+++ b/extra/bson/reader/reader.factor
@@ -10,65 +10,46 @@ FROM: typed => TYPED: ;
 
 IN: bson.reader
 
-<PRIVATE
-
-TUPLE: element { type integer } name ;
-
-TUPLE: state
-    { size initial: -1 }
-    { exemplar assoc }
-    result
-    { scope vector }
-    { elements vector } ;
+SYMBOL: state
 
-TYPED: (prepare-elements) ( -- elements-vector: vector )
-    V{ } clone [ T_Object "" element boa swap push ] [ ] bi ; inline
+DEFER: stream>assoc
 
-: <state> ( exemplar -- state )
-    [ state new ] dip
-    {
-        [ clone >>exemplar ]
-        [ clone >>result ]
-        [ V{ } clone [ push ] keep >>scope ]
-    } cleave
-    (prepare-elements) >>elements ;
+<PRIVATE
 
-TYPED: get-state ( -- state: state )
-    state get ; inline
+DEFER: read-elements
 
-TYPED: read-int32 ( -- int32: integer )
+: read-int32 ( -- int32 )
     4 read signed-le> ; inline
 
-TYPED: read-longlong ( -- longlong: integer )
+: read-longlong ( -- longlong )
     8 read signed-le> ; inline
 
-TYPED: read-double ( -- double: float )
+: read-double ( -- double )
     8 read le> bits>double ; inline
 
-TYPED: read-byte-raw ( -- byte-raw: byte-array )
+: read-byte-raw ( -- byte-raw )
     1 read ; inline
 
-TYPED: read-byte ( -- byte: integer )
+: read-byte ( -- byte )
     read-byte-raw first ; inline
 
-TYPED: read-cstring ( -- string: string )
+: read-cstring ( -- string )
     "\0" read-until drop >string ; inline
 
-TYPED: read-sized-string ( length: integer -- string: string )
+: read-sized-string ( length -- string )
     read 1 head-slice* >string ; inline
 
-TYPED: push-element ( type: integer name: string state: state -- )
-    [ element boa ] dip elements>> push ; inline
+: read-timestamp ( -- timestamp )
+    8 read [ 4 head signed-le> ] [ 4 tail signed-le> ] bi <mongo-timestamp> ;
 
-TYPED: pop-element ( state: state -- element: element )
-    elements>> pop ; inline
+: object-result ( quot -- object )
+    [
+        state get clone
+        [ clear-assoc ] [ ] [ ] tri state
+    ] dip with-variable ; inline
 
-TYPED: peek-scope ( state: state -- ht )
-    scope>> last ; inline
-
-: bson-object-data-read ( -- object )
-    read-int32 drop get-state 
-    [ exemplar>> clone dup ] [ scope>> ] bi push ; inline
+: bson-object-data-read ( -- )
+    read-int32 drop read-elements ; inline recursive
 
 : bson-binary-read ( -- binary )
    read-int32 read-byte 
@@ -86,68 +67,35 @@ TYPED: bson-regexp-read ( -- mdbregexp: mdbregexp )
 TYPED: bson-oid-read ( -- oid: oid )
     read-longlong read-int32 oid boa ; inline
 
-TYPED: element-data-read ( type: integer -- object )
-    {
-        { T_OID [ bson-oid-read ] }
-        { T_String [ read-int32 read-sized-string ] }
-        { T_Integer [ read-int32 ] }
-        { T_Binary [ bson-binary-read ] }
-        { T_Object [ bson-object-data-read ] }
-        { T_Array [ bson-object-data-read ] }
-        { T_Double [ read-double ] }
-        { T_Boolean [ read-byte 1 = ] }
-        { T_Date [ read-longlong millis>timestamp ] }
-        { T_Regexp [ bson-regexp-read ] }
-        { T_NULL [ f ] }
-    } case ; inline
-
-TYPED: bson-array? ( type: integer -- ?: boolean )
-    T_Array = ; inline
-
-TYPED: bson-object? ( type: integer -- ?: boolean )
-    T_Object = ; inline
-
 : check-object ( assoc -- object )
     dup dbref-assoc? [ assoc>dbref ] when ; inline
 
-TYPED: fix-result ( assoc type: integer -- result )
+TYPED: element-data-read ( type: integer -- object )
     {
-        { T_Array [ values ] }
-        { T_Object [ check-object ] }
-    } case ; inline
-
-TYPED: end-element ( type: integer -- )
-    { [ bson-object? ] [ bson-array? ] } 1||
-    [ get-state pop-element drop ] unless ; inline
-
-TYPED: (>state<) ( -- state: state scope: vector element: element )
-    get-state [  ] [ scope>> ] [ pop-element ] tri ; inline
-
-TYPED: (prepare-result) ( scope: vector element: element -- result )
-    [ pop ] [ type>> ] bi* fix-result ; inline
-
-: 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
-
-TYPED: (prepare-object) ( type: integer -- object )
-    [ element-data-read ] [ end-element ] bi ; inline
-
-:: (read-object) ( type name state -- )
-    state peek-scope :> scope
-    type (prepare-object) name scope set-at ; inline
-
-TYPED: bson-not-eoo-element-read ( type: integer -- cont?: boolean )
-    read-cstring get-state
-    [ push-element ]
-    [ (read-object) t ] 3bi ; inline
+        { T_OID         [ bson-oid-read ] }
+        { T_String      [ read-int32 read-sized-string ] }
+        { T_Integer     [ read-int32 ] }
+        { T_Integer64   [ read-longlong ] }
+        { T_Binary      [ bson-binary-read ] }
+        { T_Object      [ [ bson-object-data-read ] object-result check-object ] }
+        { T_Array       [ [ bson-object-data-read ] object-result values ] }
+        { T_Double      [ read-double ] }
+        { T_Boolean     [ read-byte 1 = ] }
+        { T_Date        [ read-longlong millis>timestamp ] }
+        { T_Regexp      [ bson-regexp-read ] }
+        { T_Timestamp   [ read-timestamp ] }
+        { T_Code        [ read-int32 read-sized-string ] }
+        { T_ScopedCode  [ read-int32 drop read-cstring H{ } clone stream>assoc <mongo-scoped-code> ] }
+        { T_NULL        [ f ] }
+    } case ; inline recursive
+
+TYPED: (read-object) ( type: integer name: string -- )
+    [ element-data-read ] dip state get set-at ; inline recursive
 
 TYPED: (element-read) ( type: integer -- cont?: boolean )
     dup T_EOO > 
-    [ bson-not-eoo-element-read ]
-    [ drop bson-eoo-element-read ] if ; inline
+    [ read-cstring (read-object) t ]
+    [ drop f ] if ; inline recursive
 
 : read-elements ( -- )
     read-byte (element-read)
@@ -156,6 +104,6 @@ TYPED: (element-read) ( type: integer -- cont?: boolean )
 PRIVATE>
 
 : stream>assoc ( exemplar -- assoc )
-    <state> read-int32 >>size
-    [ state [ read-elements ] with-variable ]
-    [ result>> ] bi ;
+    clone [
+        state [ bson-object-data-read ] with-variable
+    ] keep ;