extra/tokyo/assoc-functor/assoc-functor.factor

   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 functors kernel sequences serialize
   5 tokyo.alien.tcutil tokyo.utils vectors ;
   6 IN: tokyo.assoc-functor
   7
   8 <FUNCTOR: define-tokyo-assoc-api ( T N -- )
   9
  10 DBGET      IS ${T}get
  11 DBPUT      IS ${T}put
  12 DBOUT      IS ${T}out
  13 DBDEL      IS ${T}del
  14 DBRNUM     IS ${T}rnum
  15 DBITERINIT IS ${T}iterinit
  16 DBITERNEXT IS ${T}iternext
  17 DBVANISH   IS ${T}vanish
  18
  19 DBKEYS DEFINES tokyo-${N}-keys
  20
  21 TYPE DEFINES-CLASS tokyo-${N}
  22
  23 WHERE
  24
  25 TUPLE: TYPE handle disposed ;
  26
  27 INSTANCE: TYPE assoc
  28
  29 M: TYPE dispose* [ DBDEL f ] change-handle drop ;
  30
  31 M: TYPE at*
  32     handle>> swap object>bytes dup length 0 int <ref>
  33     DBGET [ [ memory>object ] [ tcfree ] bi t ] [ f f ] if* ;
  34
  35 M: TYPE assoc-size handle>> DBRNUM ;
  36
  37 : DBKEYS ( db -- keys )
  38     [ assoc-size <vector> ] [ handle>> ] bi
  39     dup DBITERINIT drop 0 int <ref>
  40     [ 2dup DBITERNEXT ] [
  41         [ memory>object ] [ tcfree ] bi
  42         reach push
  43     ] while* 2drop ;
  44
  45 M: TYPE >alist
  46     [ DBKEYS dup ] keep '[ dup _ at 2array ] map! drop ;
  47
  48 M: TYPE set-at
  49     handle>> swap rot [ object>bytes dup length ] bi@ DBPUT drop ;
  50
  51 M: TYPE delete-at
  52     handle>> swap object>bytes dup length DBOUT drop ;
  53
  54 M: TYPE clear-assoc handle>> DBVANISH drop ;
  55
  56 M: TYPE equal? assoc= ;
  57
  58 M: TYPE hashcode* assoc-hashcode ;
  59
  60 ;FUNCTOR>