diff --git a/bson/bson.factor b/bson/bson.factor
index 4be8e2d3ed..a97b5029b0 100644
--- a/bson/bson.factor
+++ b/bson/bson.factor
@@ -1,9 +1,6 @@
+USING: vocabs.loader ;
 
 IN: bson
 
-USE: vocabs.loader
-
-SINGLETON: bson-null
-
 "bson.reader" require
 "bson.writer" require
diff --git a/bson/constants/constants.factor b/bson/constants/constants.factor
index f519c0f998..8f5b61a671 100644
--- a/bson/constants/constants.factor
+++ b/bson/constants/constants.factor
@@ -1,31 +1,40 @@
-USING: alien.c-types ;
+USING: alien.c-types accessors kernel calendar random math.bitwise math unix ;
 
 IN: bson.constants
 
 TUPLE: oid { a initial: 0 } { b initial: 0 } ;
 
+: <oid> ( -- oid )
+    oid new
+    now timestamp>micros >>a
+    8 random-bits 16 shift HEX: FF0000 mask
+    getpid HEX: FFFF mask
+    bitor >>b ;
 
-: T_EOO ( -- type ) 0 ; inline
-: T_Double ( -- type ) 1 ; inline
-: T_Integer ( -- type ) 16 ; inline
-: T_Boolean ( -- type ) 8 ; inline
-: T_String ( -- type ) 2 ; inline
-: T_Object ( -- type ) 3 ; inline
-: T_Array ( -- type ) 4 ; inline
-: T_Binary ( -- type ) 5 ; inline
-: T_Undefined ( -- type ) 6 ; inline
-: T_OID ( -- type ) 7 ; inline
-: T_Date ( -- type ) 9 ; inline
-: T_NULL ( -- type ) 10 ; inline
-: T_Regexp ( -- type ) 11 ; inline
-: T_DBRef ( -- type ) 12 ; inline
-: T_Code ( -- type ) 13 ; inline
-: T_ScopedCode ( -- type ) 17 ; inline
-: T_Symbol ( -- type ) 14 ; inline
-: T_JSTypeMax ( -- type ) 16 ; inline
-: T_MaxKey ( -- type ) 127 ; inline
-
-: T_Binary_Bytes ( -- subtype ) 2 ; inline
-: T_Binary_Function ( -- subtype ) 1 ; inline 
+TUPLE: dbref ns oid ;
+
+
+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_Bytes 2  
+CONSTANT: T_Binary_Function 1   
 
 
diff --git a/bson/reader/reader.factor b/bson/reader/reader.factor
index b7ef83d80e..5aebb4bcee 100644
--- a/bson/reader/reader.factor
+++ b/bson/reader/reader.factor
@@ -1,21 +1,21 @@
 USING: mirrors io io.encodings.utf8 io.encodings.binary math match kernel sequences
        splitting accessors io.streams.byte-array namespaces prettyprint
        bson.constants assocs alien.c-types alien.strings fry words
-       tools.walker serialize locals byte-arrays ;
+       serialize byte-arrays ;
 
 IN: bson.reader
 
-ERROR: size-mismatch actual declared ;
-
 <PRIVATE
 
 TUPLE: element { type integer } name ;
-TUPLE: state { size initial: -1 } { read initial: 0 } exemplar result scope element ;
+TUPLE: state
+    { size initial: -1 } { read initial: 0 } exemplar
+    result scope element ;
 
-:: <state> ( exemplar -- state )
-    state new  
-    exemplar clone >>exemplar
-    exemplar clone [ >>result ] [ V{ } clone [ push ] keep >>scope ] bi
+: <state> ( exemplar -- state )
+    [ state new ] dip
+    [ clone >>exemplar ] keep
+    clone [ >>result ] [ V{ } clone [ push ] keep >>scope ] bi
     V{ } clone [ T_Object "" element boa swap push ] keep >>element ; inline
 
 PREDICATE: bson-eoo     < integer T_EOO = ;
@@ -101,6 +101,18 @@ M: bson-array fix-result ( assoc type -- result )
     drop
     values ;
 
+GENERIC: end-element ( type -- )
+
+M: bson-object end-element ( type -- )
+    drop ;
+
+M: bson-array end-element ( type -- )
+    drop ;
+
+M: object end-element ( type -- )
+    drop
+    pop-element drop ;
+
 M: bson-eoo element-read ( type -- cont? )
     drop
     get-state scope>> [ pop ] keep swap ! vec assoc
@@ -113,9 +125,10 @@ M: bson-eoo element-read ( type -- cont? )
 M: bson-not-eoo element-read ( type -- cont? )
     [ peek-scope ] dip                                 ! scope type 
     '[  _ 
-        read-cstring push-element [ name>> ] [ type>> ] bi 
-        element-data-read 
-        swap
+       read-cstring push-element [ name>> ] [ type>> ] bi 
+       [ element-data-read ] keep
+       end-element
+       swap
     ] dip    
     set-at
     t ;
@@ -124,8 +137,7 @@ M: bson-oid element-data-read ( type -- object )
     drop
     read-longlong
     read-int32
-    oid boa
-    pop-element drop ;
+    oid boa ;
 
 : [scope-changer] ( state -- state quot )
     dup exemplar>> '[ [ [ _ clone ] dip push ] keep ] ; inline
@@ -145,28 +157,34 @@ M: bson-array element-data-read ( type -- object )
     
 M: bson-string element-data-read ( type -- object )
     drop
-    read-int32 read-sized-string
-    pop-element drop ;
+    read-int32 read-sized-string ;
 
 M: bson-integer element-data-read ( type -- object )
     drop
-    read-int32
-    pop-element drop ;
+    read-int32 ;
 
 M: bson-double element-data-read ( type -- double )
     drop
-    read-double
-    pop-element drop ;
+    read-double ;
 
 M: bson-boolean element-data-read ( type -- boolean )
     drop
-    read-byte t =
-    pop-element drop ;
+    read-byte t = ;
+
+M: bson-ref element-data-read ( type -- dbref )
+    drop
+    read-int32
+    read-sized-string
+    T_OID element-data-read
+    dbref boa ;
 
 M: bson-binary element-data-read ( type -- binary )
     drop
-    read-int32 read-byte element-binary-read
-    pop-element drop ;
+    read-int32 read-byte element-binary-read ;
+
+M: bson-null element-data-read ( type -- bf  )
+    drop
+    f ;
 
 M: bson-binary-bytes element-binary-read ( size type -- bytes )
     drop read ;
@@ -176,17 +194,13 @@ M: bson-binary-function element-binary-read ( size type -- quot )
 
 PRIVATE>
 
-GENERIC: stream>assoc ( exemplar -- assoc )
-
-M: assoc stream>assoc ( exemplar -- assoc )
+: stream>assoc ( exemplar -- assoc )
     <state> dup state
         [ read-int32 >>size read-elements ] with-variable 
         result>> ;
-
-USING: multi-methods ;
-    
-GENERIC: array>assoc ( array exemplar -- assoc )
-    
-METHOD: array>assoc { byte-array assoc } ( array exemplar -- assoc )
+        
+: array>assoc  ( array exemplar -- assoc )
     [ binary ] dip '[ _ stream>assoc ] with-byte-reader ;
 
+: array>hashtable ( array -- assoc )
+    H{ } array>assoc ;
diff --git a/bson/writer/writer.factor b/bson/writer/writer.factor
index a85a9867c5..c5e9b02ef8 100644
--- a/bson/writer/writer.factor
+++ b/bson/writer/writer.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: bson bson.constants accessors kernel io.streams.string
        io.encodings.binary classes byte-arrays quotations serialize
-       io.encodings.utf8 strings splitting math.parser locals
+       io.encodings.utf8 strings splitting math.parser 
        sequences math assocs classes words make fry 
        prettyprint hashtables mirrors alien.strings alien.c-types
        io.streams.byte-array io ;
@@ -19,7 +19,8 @@ GENERIC: bson-write ( obj -- )
 M: t bson-type? ( boolean -- type ) drop T_Boolean ; 
 M: f bson-type? ( boolean -- type ) drop T_Boolean ; 
 
-M: oid bson-type? ( word -- type ) drop T_OID ; 
+M: oid bson-type? ( word -- type ) drop T_OID ;
+M: dbref bson-type? ( dbref -- type ) drop T_DBRef ;
 M: real bson-type? ( real -- type ) drop T_Double ; 
 M: word bson-type? ( word -- type ) drop T_String ; 
 M: tuple bson-type? ( tuple -- type ) drop T_Object ;  
@@ -28,7 +29,6 @@ M: string bson-type? ( string -- type ) drop T_String ;
 M: integer bson-type? ( integer -- type ) drop T_Integer ; 
 M: sequence bson-type? ( seq -- type ) drop T_Array ; 
 M: quotation bson-type? ( quotation -- type ) drop T_Binary ; 
-M: bson-null bson-type? ( null -- type ) drop T_NULL ; 
 M: byte-array bson-type? ( byte-array -- type ) drop T_Binary ; 
 
 : write-byte ( byte -- ) <char> write ; inline
@@ -48,9 +48,6 @@ M: f bson-write ( f -- )
 M: t bson-write ( t -- )
     drop 1 write-byte ;
 
-M: bson-null bson-write ( null -- )
-    drop ;
-
 M: string bson-write ( obj -- )
     utf8 string>alien 
     [ length write-int32 ] keep
@@ -74,6 +71,12 @@ M: quotation bson-write ( quotation -- )
 
 M: oid bson-write ( oid -- )
     [ a>> write-longlong ] [ b>> write-int32 ] bi ;
+
+M: dbref bson-write ( dbref -- )
+    [ ns>> utf8 string>alien 
+      [ length write-int32 ] keep write
+    ]
+    [ oid>> bson-write ] bi ;
     
 M: sequence bson-write ( array -- )
     '[ _ [ [ write-type ] dip number>string write-cstring bson-write ]
diff --git a/mongodb/mongodb.factor b/mongodb/mongodb.factor
index b706dcffa6..b9c15c0317 100644
--- a/mongodb/mongodb.factor
+++ b/mongodb/mongodb.factor
@@ -1,15 +1,49 @@
-USING: mongodb.persistent ;
+USING: accessors assocs fry io.encodings.binary io.sockets kernel math
+math.parser mongodb.msg mongodb.persistent mongodb.query mongodb.tuple
+namespaces sequences splitting ;
 
 IN: mongodb
 
+INTERSECTION: storable mdb-persistent ;
+
+<PRIVATE
 
 
-GENERIC: store ( tuple/ht -- tuple/ht )
-GENERIC: load ( example -- tuple/ht )
+: prepare-find ( example -- query )
+    [ mdb-collection>> get-collection-fqn ] keep
+    H{ } tuple>query <mdb-query-msg> ; inline
 
-M: tuple store ( tuple -- tuple )
-    [ check-persistent-tuple ] keep ;
+PRIVATE>
 
-M: persistent-tuple store ( ptuple -- ptuple )
-    ;
+
+: <mdb> ( db host port -- mdb )
+    (<mdb>) ;
+
+
+GENERIC: store ( tuple/ht -- )
+
+GENERIC: find ( example -- tuple/ht )
+
+GENERIC: findOne ( exampe -- tuple/ht )
+
+GENERIC: load ( object -- object ) 
+
+
+M: storable store ( tuple --  )
+    prepare-store ! H { collection { ... values ... } 
+    [ [ <mdb-insert-msg> ] 2dip  
+        [ get-collection-fqn >>collection ] dip
+    objects>>
+    [ mdb>> master>> binary ] dip '[ _ write-request ] with-client   
+    ] assoc-each  ;
+
+M: storable find ( example -- result )
+    prepare-find (find)
+    build-result ;
+
+M: storable findOne ( example -- result )
+    prepare-find (find-one)
+    dup returned#>> 1 = 
+    [ objects>> first ]
+    [ drop f ] if ;
 
diff --git a/mongodb/persistent/persistent.factor b/mongodb/persistent/persistent.factor
index d438fbf978..c7c3fcf134 100644
--- a/mongodb/persistent/persistent.factor
+++ b/mongodb/persistent/persistent.factor
@@ -1,81 +1,129 @@
-USING: accessors classes classes.mixin classes.tuple compiler.units
-fry kernel words locals mirrors formatting assocs hashtables ;
+USING: accessors assocs classes fry kernel linked-assocs math mirrors
+namespaces sequences strings vectors words bson.constants 
+continuations ;
 
 IN: mongodb.persistent
 
-MIXIN: persistent-tuple
+MIXIN: mdb-persistent
 
-SLOT: _p_oid
-SLOT: _p_info
+SLOT: _id
 
-TUPLE: oid { a initial: 0 } { b initial: 0 } ;
+CONSTANT: MDB_P_SLOTS { "_id" } 
+CONSTANT: MDB_OID "_id"
 
-: MDB_CLASS ( -- string ) "p_class" ; inline
-: MDB_VOCAB ( -- string ) "p_vocab" ; inline
-: MDB_MT ( -- string ) "p_mt" ; inline
-: MDB_CT ( -- string ) "p_ct" ; inline
-: MDB_COL ( -- string ) "p_col" ; inline 
+SYMBOL: mdb-op-seq
 
-PREDICATE: pinfo-hashtable < hashtable  [ MDB_CLASS swap key? ] [ MDB_VOCAB swap key? ] bi and ;
+GENERIC# tuple>assoc 1 ( tuple exemplar -- assoc )
 
-: P_OID ( -- name ) "_p_oid" ; inline
-: P_INFO ( -- name ) "_p_info" ; inline
+: tuple>linked-assoc ( tuple -- linked-assoc )
+    <linked-hash> tuple>assoc ; inline
 
-: P_SLOTS ( -- array )
-    { "_p_oid" "_p_info" } ;
+GENERIC# tuple>query 1 ( tuple examplar -- query-assoc )
+
+GENERIC: mdb-collection>> ( tuple -- string )
+
+GENERIC: mdb-slot-definitions>> ( tuple -- string )
+
+
+DEFER: assoc>tuple
+DEFER: create-mdb-command
 
 <PRIVATE
 
-: P_VOCAB ( -- string )
-    "mongodb.persistent" ; inline
+CONSTANT: MDB_INFO "_mdb_info"
 
-:: define-persistent-tuple ( superclass name -- class )
-    [let | pclass [ name P_VOCAB create ] |
-        [ pclass pclass [  ] curry define ] with-compilation-unit
-        [ pclass superclass P_SLOTS define-tuple-class
-          pclass persistent-tuple add-mixin-instance ] with-compilation-unit
-        pclass ] ; 
-    
-:: copy-slots ( tuple 'tuple -- 'tuple )
-    [let | tm1 [ tuple <mirror> ]
-           tm2 [ 'tuple <mirror> ] |
-        tm1 [ swap tm2 set-at ] assoc-each
-        tm2 object>> ] ;
+: <dbref> ( tuple -- dbref )
+    [ mdb-collection>> ] [ _id>> ] bi dbref boa ; inline
+
+: mdbinfo>tuple-class ( mdbinfo -- class )
+    [ first ] keep second lookup ; inline
+
+: make-tuple ( assoc -- tuple )
+    [ MDB_INFO swap at mdbinfo>tuple-class new ] keep ! instance assoc
+    [ dup <mirror> [ keys ] keep ] dip ! instance array mirror assoc
+    '[ dup _ [ _ at assoc>tuple ] dip [ swap ] dip set-at ] each ;  
+
+: persistent-info ( tuple -- pinfo )
+    class V{ } clone tuck  
+    [ [ name>> ] dip push ]
+    [ [ vocabulary>> ] dip push ] 2bi ; inline
+
+: id-or-f? ( key value -- key value boolean )
+    over "_id" = 
+    [ dup f = ] dip or ; inline
+
+: write-persistent-info ( mirror exemplar assoc -- )
+    [ drop ] dip 
+    2dup [ "_id" ] 2dip [ over [ at ] dip ] dip set-at
+    [ object>> persistent-info MDB_INFO ] dip set-at ;    
+
+: persistent-tuple? ( object -- object boolean )
+    dup mdb-persistent? ; inline
+
+: ensure-value-ht ( key ht -- vht )
+    2dup key?
+    [ at ]
+    [ [ H{ } clone dup ] 2dip set-at ] if ; inline
+
+: data-tuple? ( tuple -- ? )
+    dup tuple? [ assoc? [ f ] [ t ] if ] [ drop f ] if  ;
+
+: write-tuple-fields ( mirror exemplar assoc -- )
+    [ dup ] dip ! m e e a
+    '[ id-or-f?
+       [ 2drop ]
+       [ persistent-tuple?
+         [ _ keep
+           [ mdb-collection>> ] keep
+           [ create-mdb-command ] dip
+           <dbref> ]
+         [ dup data-tuple? _ [ ] if ] if
+         swap _ set-at
+       ] if
+    ] assoc-each ; 
+
+: prepare-assoc ( tuple exemplar -- assoc mirror exemplar assoc )
+    [ <mirror> ] dip dup clone swap [ tuck ] dip swap ; inline
     
+: ensure-mdb-info ( tuple -- tuple )    
+    dup _id>> [ <oid> >>_id ] unless ; inline
+  
+: with-op-seq ( quot -- op-seq )
+    [
+        [ H{ } clone mdb-op-seq set ] dip call mdb-op-seq get
+    ] with-scope ; inline
+
 PRIVATE>
 
-GENERIC: persistent-tuple-class ( tuple -- class )
+: create-mdb-command ( assoc ns -- )
+    mdb-op-seq get
+    ensure-value-ht
+    [ dup [ MDB_OID ] dip at ] dip
+    set-at ; inline
 
-M: tuple persistent-tuple-class ( tuple -- class )
-    class persistent-tuple-class ;
+: prepare-store ( mdb-persistent -- op-seq )
+    '[ _ [ tuple>linked-assoc ] keep mdb-collection>> create-mdb-command ]
+    with-op-seq ; inline
 
-M: pinfo-hashtable persistent-tuple-class ( tuple -- class )
-    [ MDB_CLASS swap at ] [ MDB_VOCAB swap at ] bi lookup
-    persistent-tuple-class ;
+M: mdb-persistent tuple>assoc ( tuple exemplar -- assoc )
+    [ ensure-mdb-info ] dip ! tuple exemplar
+    prepare-assoc
+    [ write-persistent-info ]
+    [ [ '[ _ tuple>assoc ] ] dip write-tuple-fields ] 3bi ;
 
-M: tuple-class persistent-tuple-class ( class -- class' )
-    [ [ vocabulary>> ] [ name>> ] bi ] keep ! name vocab class
-    [ "%s_%s" sprintf ] dip swap dup   ! class new_name new_name
-    P_VOCAB lookup dup                 ! class new_name vo/f vo/f
-    [ [ drop drop ] dip ] [ drop define-persistent-tuple ] if ;
+M: tuple tuple>assoc ( tuple exemplar -- assoc )
+    [ drop persistent-info MDB_INFO ] 2keep
+    prepare-assoc [ '[ _ tuple>assoc ] ] write-tuple-fields
+    [ set-at ] keep ;
+
+M: tuple tuple>query ( tuple examplar -- assoc )
+    prepare-assoc [ '[ _ tuple>query ] ] dip write-tuple-fields ;
+
+: assoc>tuple ( assoc -- tuple )
+    dup assoc?
+    [ [ dup MDB_INFO swap key?
+        [ make-tuple ]
+        [ ] if ] [ drop ] recover
+    ] [ ] if ; inline
 
 
-GENERIC: make-persistent ( tuple -- 'tuple )
-
-M: tuple make-persistent ( tuple -- 'tuple )
-    [let* | tuple [  ]
-            tclass [ tuple class ]
-            'tuple [ tclass persistent-tuple-class new ]
-            pinfo  [ H{  } clone ] |
-        tuple 'tuple copy-slots
-        oid new >>_p_oid
-        tclass name>> MDB_CLASS pinfo set-at
-        tclass vocabulary>> MDB_VOCAB pinfo set-at
-        0 MDB_MT pinfo set-at
-        0 MDB_CT pinfo set-at
-        "" MDB_COL pinfo set-at
-         pinfo >>_p_info
-    ] ; 
-
-M: persistent-tuple make-persistent ( tuple -- tuple )
-    ;