1 ! Copyright (C) 2009 Bruno Deferrari
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.data arrays assocs
4 destructors fry functors kernel locals sequences serialize
5 tokyo.alien.tcutil tokyo.utils vectors ;
6 IN: tokyo.assoc-functor
8 FUNCTOR: define-tokyo-assoc-api ( T N -- )
15 DBITERINIT IS ${T}iterinit
16 DBITERNEXT IS ${T}iternext
17 DBVANISH IS ${T}vanish
19 DBKEYS DEFINES tokyo-${N}-keys
21 TYPE DEFINES-CLASS tokyo-${N}
25 TUPLE: TYPE handle disposed ;
29 M: TYPE dispose* [ DBDEL f ] change-handle drop ;
31 M: TYPE at* ( key db -- value/f ? )
32 handle>> swap object>bytes dup length 0 int <ref>
33 DBGET [ [ memory>object ] [ tcfree ] bi t ] [ f f ] if* ;
35 M: TYPE assoc-size ( db -- size ) handle>> DBRNUM ;
37 : DBKEYS ( db -- keys )
38 [ assoc-size <vector> ] [ handle>> ] bi
39 dup DBITERINIT drop 0 int <ref>
40 [ 2dup DBITERNEXT dup ] [
41 [ memory>object ] [ tcfree ] bi
42 [ pick ] dip swap push
45 M: TYPE >alist ( db -- alist )
46 [ DBKEYS dup ] keep '[ dup _ at 2array ] map! drop ;
48 M: TYPE set-at ( value key db -- )
49 handle>> swap rot [ object>bytes dup length ] bi@ DBPUT drop ;
51 M: TYPE delete-at ( key db -- )
52 handle>> swap object>bytes dup length DBOUT drop ;
54 M: TYPE clear-assoc ( db -- ) handle>> DBVANISH drop ;
56 M: TYPE equal? assoc= ;
58 M: TYPE hashcode* assoc-hashcode ;