extra/mongodb/tuple/state/state.factor

   1 USING: classes kernel accessors sequences fry assocs mongodb.tuple.collection
   2 words classes.tuple slots generic ;
   3
   4 IN: mongodb.tuple.state
   5
   6 <PRIVATE
   7
   8 CONSTANT: MDB_TUPLE_INFO       "_mfd_t_info"
   9 CONSTANT: MDB_DIRTY_FLAG       "d?"
  10 CONSTANT: MDB_PERSISTENT_FLAG  "p?"
  11 CONSTANT: MDB_DIRTY_ADVICE     "mdb-dirty-set"
  12
  13 PRIVATE>
  14
  15 SYMBOL: mdb-dirty-handling?
  16
  17 : advised-with? ( name word loc -- ? )
  18    word-prop key? ; inline
  19
  20 : <tuple-info> ( tuple -- tuple-info )
  21     class V{ } clone tuck
  22     [ [ name>> ] dip push ]
  23     [ [ vocabulary>> ] dip push ] 2bi ; inline
  24
  25 : tuple-info ( assoc -- tuple-info )
  26     [ MDB_TUPLE_INFO ] dip at ; inline
  27
  28 : set-tuple-info ( tuple assoc -- )
  29    [ <tuple-info> MDB_TUPLE_INFO ] dip set-at ; inline
  30
  31 : tuple-info? ( assoc -- ? )
  32    [ MDB_TUPLE_INFO ] dip key? ;
  33
  34 : tuple-meta ( tuple -- assoc )
  35    dup _mfd>> [ ] [ H{ } clone [ >>_mfd ] keep ] if* nip ; inline
  36
  37 : dirty? ( tuple -- ? )
  38    [ MDB_DIRTY_FLAG ] dip tuple-meta at ;
  39
  40 : mark-dirty ( tuple -- )
  41    [ t MDB_DIRTY_FLAG ] dip tuple-meta set-at ;
  42
  43 : persistent? ( tuple -- ? )
  44    [ MDB_PERSISTENT_FLAG ] dip tuple-meta at ;
  45
  46 : mark-persistent ( tuple -- )
  47    [ t MDB_PERSISTENT_FLAG ] dip tuple-meta [ set-at ] keep
  48    [ f MDB_DIRTY_FLAG ] dip set-at ;
  49
  50 : needs-store? ( tuple -- ? )
  51    [ persistent? not ] [ dirty? ] bi or ;
  52