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
   4 io io.streams.memory kernel libc locals
   5 sequences serialize tokyo.alien.tcadb tokyo.alien.tcutil vectors ;
   6 IN: tokyo.cabinet.abstract
   7
   8 TUPLE: tokyo-abstractdb handle disposed ;
   9
  10 <PRIVATE
  11 : with-memory-reader ( memory quot -- )
  12     [ <memory-stream> ] dip with-input-stream* ; inline
  13
  14 : memory>object ( memory -- object )
  15     [ deserialize ] with-memory-reader ;
  16 PRIVATE>
  17
  18 INSTANCE: tokyo-abstractdb assoc
  19
  20 : <tokyo-abstractdb> ( name -- tokyo-abstractdb )
  21     tcadbnew [ swap tcadbopen drop ] keep
  22     tokyo-abstractdb new [ (>>handle) ] keep ;
  23
  24 M: tokyo-abstractdb dispose* [ tcadbdel f ] change-handle drop ;
  25
  26 M:: tokyo-abstractdb at* ( key db -- value/f ? )
  27     0 <int>          :> sizeout
  28     db handle>>      :> handle
  29     key object>bytes :> kbytes
  30     kbytes length    :> key-size
  31     handle kbytes key-size sizeout tcadbget :> output
  32     output [
  33         [ memory>object ] [ tcfree ] bi t
  34     ] [ f f ] if* ;
  35
  36 M: tokyo-abstractdb assoc-size ( db -- size ) handle>> tcadbrnum ;
  37
  38 ! FIXME: make this nicer
  39 M:: tokyo-abstractdb >alist ( db -- alist )
  40     db handle>>            :> handle
  41     0 <int>                :> size-out
  42     db assoc-size <vector> :> keys
  43     handle tcadbiterinit drop
  44     [ handle size-out tcadbiternext dup ] [
  45         [ memory>object ] [ tcfree ] bi
  46         keys push
  47     ] while drop
  48     keys [ dup db at 2array ] { } map-as ;
  49
  50 M:: tokyo-abstractdb set-at ( value key db -- )
  51     db handle>>        :> handle
  52     key object>bytes   :> kbytes
  53     kbytes length      :> key-size
  54     value object>bytes :> vbytes
  55     vbytes length      :> value-size
  56     handle kbytes key-size vbytes value-size tcadbput drop ;
  57
  58 M:: tokyo-abstractdb delete-at ( key db -- )
  59     db handle>>      :> handle
  60     key object>bytes :> kbytes
  61     kbytes length    :> key-size
  62     handle kbytes key-size tcadbout drop ;
  63
  64 M: tokyo-abstractdb clear-assoc ( db -- ) handle>> tcadbvanish drop ;
  65
  66 M: tokyo-abstractdb equal? assoc= ;
  67
  68 M: tokyo-abstractdb hashcode* assoc-hashcode ;