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

using CONSTRUCTOR: for non-generic tuple constructors

db4
Sascha Matzke 2009-01-31 16:05:21 +01:00
parent 5dacbdaace
commit bd6be4fe27
1 changed files with 14 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
mongodb/msg/msg.factor
View File

@ -1,7 +1,7 @@
USING: io io.encodings.utf8 io.encodings.binary alien.c-types alien.strings math USING: accessors alien.c-types alien.strings assocs bson.reader
bson.writer sequences kernel accessors io.streams.byte-array fry generalizations bson.writer byte-arrays byte-vectors constructors fry io
combinators bson.reader sequences tools.walker assocs strings linked-assocs namespaces io.encodings.binary io.encodings.utf8 io.streams.byte-array kernel
byte-vectors byte-arrays ; linked-assocs math namespaces sequences strings ;
IN: mongodb.msg IN: mongodb.msg
@ -71,20 +71,14 @@ TUPLE: mdb-reply-msg < mdb-msg
{ objects sequence } ; { objects sequence } ;
: <mdb-getmore-msg> ( collection return# -- mdb-getmore-msg ) CONSTRUCTOR: mdb-getmore-msg ( collection return# -- mdb-getmore-msg )
[ mdb-getmore-msg new ] 2dip OP_GetMore >>opcode ; inline
[ >>collection ] dip
>>return# OP_GetMore >>opcode ; inline
: <mdb-delete-msg> ( collection assoc -- mdb-delete-msg ) CONSTRUCTOR: mdb-delete-msg ( collection selector -- mdb-delete-msg )
[ mdb-delete-msg new ] 2dip OP_Delete >>opcode ; inline
[ >>collection ] dip
>>selector OP_Delete >>opcode ; inline
: <mdb-query-msg> ( collection assoc -- mdb-query-msg ) CONSTRUCTOR: mdb-query-msg ( collection query -- mdb-query-msg )
[ mdb-query-msg new ] 2dip OP_Query >>opcode ; inline
[ >>collection ] dip
>>query OP_Query >>opcode ; inline
GENERIC: <mdb-killcursors-msg> ( object -- mdb-killcursors-msg ) GENERIC: <mdb-killcursors-msg> ( object -- mdb-killcursors-msg )
@ -96,9 +90,6 @@ M: sequence <mdb-killcursors-msg> ( sequences -- mdb-killcursors-msg )
M: integer <mdb-killcursors-msg> ( integer -- mdb-killcursors-msg ) M: integer <mdb-killcursors-msg> ( integer -- mdb-killcursors-msg )
V{ } clone [ push ] keep <mdb-killcursors-msg> ; V{ } clone [ push ] keep <mdb-killcursors-msg> ;
: <mdb-query-one-msg> ( collection assoc -- mdb-query-msg )
<mdb-query-msg> 1 >>return# ; inline
GENERIC# <mdb-insert-msg> 1 ( collection objects -- mdb-insert-msg ) GENERIC# <mdb-insert-msg> 1 ( collection objects -- mdb-insert-msg )
M: linked-assoc <mdb-insert-msg> ( collection linked-assoc -- mdb-insert-msg ) M: linked-assoc <mdb-insert-msg> ( collection linked-assoc -- mdb-insert-msg )
@ -112,14 +103,11 @@ M: sequence <mdb-insert-msg> ( collection sequence -- mdb-insert-msg )
[ >>collection ] dip [ >>collection ] dip
>>objects OP_Insert >>opcode ; >>objects OP_Insert >>opcode ;
: <mdb-update-msg> ( collection object -- mdb-update-msg ) CONSTRUCTOR: mdb-update-msg ( collection object -- mdb-update-msg )
[ mdb-update-msg new ] 2dip dup object>> [ "_id" ] dip at "_id" H{ } clone [ set-at ] keep >>selector
[ >>collection ] dip OP_Update >>opcode ;
[ [ "_id" ] dip at "_id" H{ } clone [ set-at ] keep >>selector ] keep
>>object OP_Update >>opcode ;
: <mdb-reply-msg> ( -- mdb-reply-msg ) CONSTRUCTOR: mdb-reply-msg ( -- mdb-reply-msg ) ; inline
mdb-reply-msg new ; inline
GENERIC: write-message ( message -- ) GENERIC: write-message ( message -- )