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

tokyo: Reimplement assoc protocols for remote and abstract db using a functor

db4
Bruno Deferrari 2009-06-18 18:55:26 -03:00
parent 9d515140fe
commit f18655fd55
5 changed files with 65 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
extra/tokyo/abstractdb/abstractdb.factor
View File

@ -1,60 +1,10 @@
! 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 ;

59
extra/tokyo/assoc-functor/assoc-functor.factor Normal file
View File

@ -0,0 +1,59 @@
! 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

1
extra/tokyo/assoc-functor/authors.txt Normal file
View File

@ -0,0 +1 @@
Bruno Deferrari

1
extra/tokyo/assoc-functor/summary.txt Normal file
View File

@ -0,0 +1 @@
Functor used to implement the assoc protocol on the different db apis in Tokyo

54
extra/tokyo/remotedb/remotedb.factor
View File

@ -1,60 +1,10 @@
! 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 ;