extra/tokyo/cabinet/abstract/abstract.factor

   1 ! Copyright (C) 2009 Bruno Deferrari
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types arrays assocs destructors kernel libc locals
   4 sequences serialize tokyo.alien.tcadb tokyo.alien.tcutil vectors ;
   5 IN: tokyo.cabinet.abstract
   6
   7 TUPLE: tokyo-abstractdb handle disposed ;
   8
   9 INSTANCE: tokyo-abstractdb assoc
  10
  11 : <tokyo-abstractdb> ( name -- tokyo-abstractdb )
  12     tcadbnew [ swap tcadbopen drop ] keep
  13     tokyo-abstractdb new [ (>>handle) ] keep ;
  14
  15 M: tokyo-abstractdb dispose* [ tcadbdel f ] change-handle drop ;
  16
  17 M:: tokyo-abstractdb at* ( key db -- value/f ? )
  18     0 <int>          :> sizeout
  19     db handle>>      :> handle
  20     key object>bytes :> kbytes
  21     kbytes length    :> key-size
  22     handle kbytes key-size sizeout tcadbget :> output
  23     output [
  24         [ sizeout *int memory>byte-array ] [ tcfree ] bi bytes>object t
  25     ] [ f f ] if* ;
  26
  27 M: tokyo-abstractdb assoc-size ( db -- size ) handle>> tcadbrnum ;
  28
  29 ! FIXME: make this nicer
  30 M:: tokyo-abstractdb >alist ( db -- alist )
  31     db handle>>            :> handle
  32     0 <int>                :> size-out
  33     db assoc-size <vector> :> keys
  34     handle tcadbiterinit drop
  35     [ handle size-out tcadbiternext dup ] [
  36         [ size-out *int memory>byte-array ] [ tcfree ] bi
  37         bytes>object keys push
  38     ] while drop
  39     keys [ dup db at 2array ] { } map-as ;
  40
  41 M:: tokyo-abstractdb set-at ( value key db -- )
  42     db handle>>        :> handle
  43     key object>bytes   :> kbytes
  44     kbytes length      :> key-size
  45     value object>bytes :> vbytes
  46     vbytes length      :> value-size
  47     handle kbytes key-size vbytes value-size tcadbput drop ;
  48
  49 M:: tokyo-abstractdb delete-at ( key db -- )
  50     db handle>>      :> handle
  51     key object>bytes :> kbytes
  52     kbytes length    :> key-size
  53     handle kbytes key-size tcadbout drop ;
  54
  55 M: tokyo-abstractdb clear-assoc ( db -- ) handle>> tcadbvanish drop ;
  56
  57 M: tokyo-abstractdb equal? assoc= ;
  58
  59 M: tokyo-abstractdb hashcode* assoc-hashcode ;