1 USING: accessors assocs hashtables constructors kernel linked-assocs math
7 CONSTANT: OP_Message 1000
8 CONSTANT: OP_Update 2001
9 CONSTANT: OP_Insert 2002
10 CONSTANT: OP_Query 2004
11 CONSTANT: OP_GetMore 2005
12 CONSTANT: OP_Delete 2006
13 CONSTANT: OP_KillCursors 2007
15 CONSTANT: ResultFlag_CursorNotFound 1 ! /* returned, with zero results, when getMore is called but the cursor id is not valid at the server. */
16 CONSTANT: ResultFlag_ErrSet 2 ! /* { $err : ... } is being returned */
17 CONSTANT: ResultFlag_ShardConfigStale 4 ! /* have to update config from the server, usually $err is also set */
21 { req-id integer initial: 0 }
22 { resp-id integer initial: 0 }
23 { length integer initial: 0 }
24 { flags integer initial: 0 } ;
26 TUPLE: mdb-query-msg < mdb-msg
28 { skip# integer initial: 0 }
29 { return# integer initial: 0 }
31 { returnfields assoc }
35 TUPLE: mdb-insert-msg < mdb-msg
37 { objects sequence } ;
39 TUPLE: mdb-update-msg < mdb-msg
41 { update-flags integer initial: 0 }
45 TUPLE: mdb-delete-msg < mdb-msg
47 { delete-flags integer initial: 0 }
50 TUPLE: mdb-getmore-msg < mdb-msg
52 { return# integer initial: 0 }
53 { cursor integer initial: 0 }
54 { query mdb-query-msg } ;
56 TUPLE: mdb-killcursors-msg < mdb-msg
57 { cursors# integer initial: 0 }
58 { cursors sequence } ;
60 TUPLE: mdb-reply-msg < mdb-msg
62 { cursor integer initial: 0 }
63 { start# integer initial: 0 }
64 { requested# integer initial: 0 }
65 { returned# integer initial: 0 }
66 { objects sequence } ;
69 CONSTRUCTOR: <mdb-getmore-msg> mdb-getmore-msg ( collection return# cursor -- mdb-getmore-msg )
70 OP_GetMore >>opcode ; inline
72 CONSTRUCTOR: <mdb-delete-msg> mdb-delete-msg ( collection selector -- mdb-delete-msg )
73 OP_Delete >>opcode ; inline
75 CONSTRUCTOR: <mdb-query-msg> mdb-query-msg ( collection query -- mdb-query-msg )
76 OP_Query >>opcode ; inline
78 GENERIC: <mdb-killcursors-msg> ( object -- mdb-killcursors-msg )
80 M: sequence <mdb-killcursors-msg> ( sequences -- mdb-killcursors-msg )
81 [ mdb-killcursors-msg new ] dip
82 [ length >>cursors# ] keep
83 >>cursors OP_KillCursors >>opcode ; inline
85 M: integer <mdb-killcursors-msg> ( integer -- mdb-killcursors-msg )
86 V{ } clone [ push ] keep <mdb-killcursors-msg> ;
88 GENERIC: <mdb-insert-msg> ( collection objects -- mdb-insert-msg )
90 M: sequence <mdb-insert-msg> ( collection sequence -- mdb-insert-msg )
91 [ mdb-insert-msg new ] 2dip
93 >>objects OP_Insert >>opcode ;
95 M: assoc <mdb-insert-msg> ( collection assoc -- mdb-insert-msg )
96 [ mdb-insert-msg new ] 2dip
98 [ V{ } clone ] dip suffix!
99 >>objects OP_Insert >>opcode ;
102 CONSTRUCTOR: <mdb-update-msg> mdb-update-msg ( collection selector object -- mdb-update-msg )
103 OP_Update >>opcode ; inline
105 CONSTRUCTOR: <mdb-reply-msg> mdb-reply-msg ( -- mdb-reply-msg ) ; inline