tokyo.cabinet.abstract: Implement >alist, and correctly free memory returned by tokyo...

diff --git a/extra/tokyo/alien/tcutil/tcutil.factor b/extra/tokyo/alien/tcutil/tcutil.factor
index 910f14e67d4aa971918323a38842e4246146660d..25df54d0133973960f3cfbc76ddd5cfb5f1af403 100644 (file)
--- a/extra/tokyo/alien/tcutil/tcutil.factor
+++ b/extra/tokyo/alien/tcutil/tcutil.factor
@@ -31,6 +31,7 @@ FUNCTION: void* tclistval ( TCLIST* list, int index, int* sp ) ;
 FUNCTION: char* tclistval2 ( TCLIST* list, int index ) ;
 FUNCTION: void tclistpush ( TCLIST* list, void* ptr, int size ) ;
 FUNCTION: void tclistpush2 ( TCLIST* list, char* str ) ;
+FUNCTION: void tcfree ( void* ptr ) ;
 
 TYPEDEF: void* TCCMP
 TYPEDEF: void* TCCODEC

diff --git a/extra/tokyo/cabinet/abstract/abstract.factor b/extra/tokyo/cabinet/abstract/abstract.factor
index 6f3c5768b8f8fd9f847672c4741ad914f3dffe89..a6ce2408d92d6530e8b51facc0cdda76f88ab77d 100644 (file)
--- a/extra/tokyo/cabinet/abstract/abstract.factor
+++ b/extra/tokyo/cabinet/abstract/abstract.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Bruno Deferrari
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types assocs destructors kernel libc locals
-sequences serialize tokyo.alien.tcadb ;
+USING: accessors alien.c-types arrays assocs destructors kernel libc locals
+sequences serialize tokyo.alien.tcadb tokyo.alien.tcutil vectors ;
 IN: tokyo.cabinet.abstract
 
 TUPLE: tokyo-abstractdb handle disposed ;
@@ -21,14 +21,22 @@ M:: tokyo-abstractdb at* ( key db -- value/f ? )
     kbytes length    :> key-size
     handle kbytes key-size sizeout tcadbget :> output
     output [
-        [ sizeout *int memory>byte-array bytes>object t ] [ drop ] bi
+        [ sizeout *int memory>byte-array ] [ tcfree ] bi bytes>object t
     ] [ f f ] if* ;
 
 M: tokyo-abstractdb assoc-size ( db -- size ) handle>> tcadbrnum ;
 
-! FIXME: implement
-! M: tokyo-abstractdb >alist ( db -- alist )
-!     handle>> ;
+! 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 ] [
+        [ size-out *int memory>byte-array ] [ tcfree ] bi
+        bytes>object keys push
+    ] while drop
+    keys [ dup db at 2array ] { } map-as ;
 
 M:: tokyo-abstractdb set-at ( value key db -- )
     db handle>>        :> handle