! Copyright (C) 2009 Bruno Deferrari
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays assocs destructors
-kernel locals sequences serialize vectors
-tokyo.alien.tcadb tokyo.alien.tcutil tokyo.utils ;
+USING: accessors kernel tokyo.alien.tcadb tokyo.assoc-functor ;
IN: tokyo.abstractdb
-TUPLE: tokyo-abstractdb handle disposed ;
-
-INSTANCE: tokyo-abstractdb assoc
+<< "tcadb" "abstractdb" define-tokyo-assoc-api >>
: <tokyo-abstractdb> ( name -- tokyo-abstractdb )
tcadbnew [ swap tcadbopen drop ] keep
tokyo-abstractdb new [ (>>handle) ] keep ;
-
-M: tokyo-abstractdb dispose* [ tcadbdel f ] change-handle drop ;
-
-M:: tokyo-abstractdb at* ( key db -- value/f ? )
- 0 <int> :> sizeout
- db handle>> :> handle
- key object>bytes :> kbytes
- kbytes length :> key-size
- handle kbytes key-size sizeout tcadbget :> output
- output [
- [ memory>object ] [ tcfree ] bi t
- ] [ f f ] if* ;
-
-M: tokyo-abstractdb assoc-size ( db -- size ) handle>> tcadbrnum ;
-
-! FIXME: make this nicer
-M:: tokyo-abstractdb >alist ( db -- alist )
- db handle>> :> handle
- 0 <int> :> size-out
- db assoc-size <vector> :> keys
- handle tcadbiterinit drop
- [ handle size-out tcadbiternext dup ] [
- [ memory>object ] [ tcfree ] bi
- keys push
- ] while drop
- keys [ dup db at 2array ] { } map-as ;
-
-M:: tokyo-abstractdb set-at ( value key db -- )
- db handle>> :> handle
- key object>bytes :> kbytes
- kbytes length :> key-size
- value object>bytes :> vbytes
- vbytes length :> value-size
- handle kbytes key-size vbytes value-size tcadbput drop ;
-
-M:: tokyo-abstractdb delete-at ( key db -- )
- db handle>> :> handle
- key object>bytes :> kbytes
- kbytes length :> key-size
- handle kbytes key-size tcadbout drop ;
-
-M: tokyo-abstractdb clear-assoc ( db -- ) handle>> tcadbvanish drop ;
-
-M: tokyo-abstractdb equal? assoc= ;
-
-M: tokyo-abstractdb hashcode* assoc-hashcode ;
--- /dev/null
+! Copyright (C) 2009 Bruno Deferrari
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types arrays assocs destructors functors
+kernel locals sequences serialize tokyo.alien.tcutil tokyo.utils vectors ;
+IN: tokyo.assoc-functor
+
+FUNCTOR: define-tokyo-assoc-api ( T N -- )
+
+DBGET IS ${T}get
+DBPUT IS ${T}put
+DBOUT IS ${T}out
+DBDEL IS ${T}del
+DBRNUM IS ${T}rnum
+DBITERINIT IS ${T}iterinit
+DBITERNEXT IS ${T}iternext
+DBVANISH IS ${T}vanish
+
+DBKEYS DEFINES tokyo-${N}-keys
+
+TYPE DEFINES-CLASS tokyo-${N}
+
+WHERE
+
+TUPLE: TYPE handle disposed ;
+
+INSTANCE: TYPE assoc
+
+M: TYPE dispose* [ DBDEL f ] change-handle drop ;
+
+M: TYPE at* ( key db -- value/f ? )
+ handle>> [ object>bytes dup length ] dip 0 <int>
+ DBGET [ [ memory>object ] [ tcfree ] bi t ] [ f f ] if* ;
+
+M: TYPE assoc-size ( db -- size ) handle>> DBRNUM ;
+
+: DBKEYS ( db -- keys )
+ [ assoc-size <vector> ] [ handle>> ] bi
+ dup DBITERINIT drop 0 <int>
+ [ 2dup DBITERNEXT dup ] [
+ [ memory>object ] [ tcfree ] bi
+ [ pick ] dip swap push
+ ] while 3drop ;
+
+M: TYPE >alist ( db -- alist )
+ dup DBKEYS [ over at 2array ] with nip ;
+
+M: TYPE set-at ( value key db -- )
+ handle>> spin [ object>bytes dup length ] bi@ DBPUT drop ;
+
+M: TYPE delete-at ( key db -- )
+ handle>> [ object>bytes dup length ] DBOUT drop ;
+
+M: TYPE clear-assoc ( db -- ) handle>> DBVANISH drop ;
+
+M: TYPE equal? assoc= ;
+
+M: TYPE hashcode* assoc-hashcode ;
+
+;FUNCTOR
\ No newline at end of file
--- /dev/null
+Bruno Deferrari
--- /dev/null
+Functor used to implement the assoc protocol on the different db apis in Tokyo
! Copyright (C) 2009 Bruno Deferrari
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays assocs destructors
-kernel locals sequences serialize vectors
-tokyo.alien.tcrdb tokyo.alien.tcutil tokyo.utils ;
+USING: accessors kernel tokyo.alien.tcrdb tokyo.assoc-functor ;
IN: tokyo.remotedb
-TUPLE: tokyo-remotedb handle disposed ;
-
-INSTANCE: tokyo-remotedb assoc
+<< "tcrdb" "remotedb" define-tokyo-assoc-api >>
: <tokyo-remotedb> ( host port -- tokyo-remotedb )
[ tcrdbnew dup ] 2dip tcrdbopen drop
tokyo-remotedb new [ (>>handle) ] keep ;
-
-M: tokyo-remotedb dispose* [ tcrdbdel f ] change-handle drop ;
-
-M:: tokyo-remotedb at* ( key db -- value/f ? )
- 0 <int> :> sizeout
- db handle>> :> handle
- key object>bytes :> kbytes
- kbytes length :> key-size
- handle kbytes key-size sizeout tcrdbget :> output
- output [
- [ memory>object ] [ tcfree ] bi t
- ] [ f f ] if* ;
-
-M: tokyo-remotedb assoc-size ( db -- size ) handle>> tcrdbrnum ;
-
-! FIXME: make this nicer
-M:: tokyo-remotedb >alist ( db -- alist )
- db handle>> :> handle
- 0 <int> :> size-out
- db assoc-size <vector> :> keys
- handle tcrdbiterinit drop
- [ handle size-out tcrdbiternext dup ] [
- [ memory>object ] [ tcfree ] bi
- keys push
- ] while drop
- keys [ dup db at 2array ] { } map-as ;
-
-M:: tokyo-remotedb set-at ( value key db -- )
- db handle>> :> handle
- key object>bytes :> kbytes
- kbytes length :> key-size
- value object>bytes :> vbytes
- vbytes length :> value-size
- handle kbytes key-size vbytes value-size tcrdbput drop ;
-
-M:: tokyo-remotedb delete-at ( key db -- )
- db handle>> :> handle
- key object>bytes :> kbytes
- kbytes length :> key-size
- handle kbytes key-size tcrdbout drop ;
-
-M: tokyo-remotedb clear-assoc ( db -- ) handle>> tcrdbvanish drop ;
-
-M: tokyo-remotedb equal? assoc= ;
-
-M: tokyo-remotedb hashcode* assoc-hashcode ;