started working on transparent persistence for tuples (using dynamic subclassing)

*** state: broken ***
db4
Sascha Matzke 2008-12-19 13:47:46 +01:00
parent dc825d21c5
commit f67441f493
2 changed files with 57 additions and 0 deletions

15
mongodb/mongodb.factor Normal file
View File

@ -0,0 +1,15 @@
USING: mongodb.persistent ;
IN: mongodb
GENERIC: store ( tuple/ht -- tuple/ht )
GENERIC: load ( example -- tuple/ht )
M: tuple store ( tuple -- tuple )
[ check-persistent-tuple ] keep ;
M: persistent-tuple store ( ptuple -- ptuple )
;

View File

@ -0,0 +1,42 @@
USING: formatting words classes.mixin kernel fry compiler.units
accessors classes classes.tuple ;
IN: mongodb.persistent
MIXIN: persistent-tuple
SLOT: _p_oid
SLOT: _p_info
TUPLE: oid { a initial: 0 } { b initial: 0 } ;
TUPLE: persistent-info type vocab collection dirty? mt ;
<PRIVATE
: P_VOCAB ( -- string )
"mongodb.persistent" ; inline
: P_SLOTS ( -- array )
{ "_p_oid" "_p_info" } ;
: define-persistent-tuple ( class name -- class )
P_VOCAB create ! class word
dup dup '[ _ _ [ ] curry define ] with-compilation-unit
dup [ swap ] dip
'[ _ _ P_SLOTS define-tuple-class
_ persistent-tuple define-mixin-class ] with-compilation-unit ;
PRIVATE>
GENERIC: persistent-tuple-class ( tuple -- class )
M: tuple persistent-tuple-class ( tuple -- class )
class persistent-tuple-class ;
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 ;