From 1ed16f775c06360b18aa13a4c1069fd1e037b6b1 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Thu, 13 May 2010 23:32:34 +0400 Subject: [PATCH 01/21] gdbm: add low-level interface --- extra/gdbm/ffi/authors.txt | 1 + extra/gdbm/ffi/ffi.factor | 76 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 77 insertions(+) create mode 100644 extra/gdbm/ffi/authors.txt create mode 100644 extra/gdbm/ffi/ffi.factor diff --git a/extra/gdbm/ffi/authors.txt b/extra/gdbm/ffi/authors.txt new file mode 100644 index 0000000000..e1702c7130 --- /dev/null +++ b/extra/gdbm/ffi/authors.txt @@ -0,0 +1 @@ +Dmitry Shubin diff --git a/extra/gdbm/ffi/ffi.factor b/extra/gdbm/ffi/ffi.factor new file mode 100644 index 0000000000..cf63b566fb --- /dev/null +++ b/extra/gdbm/ffi/ffi.factor @@ -0,0 +1,76 @@ +! Copyright (C) 2010 Dmitry Shubin. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types alien.libraries alien.syntax classes.struct +combinators system ; +IN: gdbm.ffi + +<< "libgdbm" os { + { [ unix? ] [ "libgdbm.so" ] } + { [ winnt? ] [ "gdbm.dll" ] } + { [ macosx? ] [ "libgdbm.dylib" ] } +} cond cdecl add-library >> + +LIBRARY: libgdbm + +C-GLOBAL: c-string gdbm_version + +CONSTANT: GDBM_READER 0 +CONSTANT: GDBM_WRITER 1 +CONSTANT: GDBM_WRCREAT 2 +CONSTANT: GDBM_NEWDB 3 +CONSTANT: GDBM_FAST HEX: 10 +CONSTANT: GDBM_SYNC HEX: 20 +CONSTANT: GDBM_NOLOCK HEX: 40 + +CONSTANT: GDBM_INSERT 0 +CONSTANT: GDBM_REPLACE 1 + +CONSTANT: GDBM_CACHESIZE 1 +CONSTANT: GDBM_FASTMODE 2 +CONSTANT: GDBM_SYNCMODE 3 +CONSTANT: GDBM_CENTFREE 4 +CONSTANT: GDBM_COALESCEBLKS 5 + +STRUCT: datum { dptr char* } { dsize int } ; + +C-TYPE: _GDBM_FILE +TYPEDEF: _GDBM_FILE* GDBM_FILE + +CALLBACK: void fatal_func_cb ; +FUNCTION: GDBM_FILE gdbm_open ( c-string name, int block_size, int read_write, int mode, fatal_func_cb fatal_func ) ; +FUNCTION: void gdbm_close ( GDBM_FILE dbf ) ; +FUNCTION: int gdbm_store ( GDBM_FILE dbf, datum key, datum content, int flag ) ; +FUNCTION: datum gdbm_fetch ( GDBM_FILE dbf, datum key ) ; +FUNCTION: int gdbm_delete ( GDBM_FILE dbf, datum key ) ; +FUNCTION: datum gdbm_firstkey ( GDBM_FILE dbf ) ; +FUNCTION: datum gdbm_nextkey ( GDBM_FILE dbf, datum key ) ; +FUNCTION: int gdbm_reorganize ( GDBM_FILE dbf ) ; +FUNCTION: void gdbm_sync ( GDBM_FILE dbf ) ; +FUNCTION: int gdbm_exists ( GDBM_FILE dbf, datum key ) ; +FUNCTION: int gdbm_setopt ( GDBM_FILE dbf, int option, int* value, int size ) ; +FUNCTION: int gdbm_fdesc ( GDBM_FILE dbf ) ; + +CONSTANT: GDBM_NO_ERROR 0 +CONSTANT: GDBM_MALLOC_ERROR 1 +CONSTANT: GDBM_BLOCK_SIZE_ERROR 2 +CONSTANT: GDBM_FILE_OPEN_ERROR 3 +CONSTANT: GDBM_FILE_WRITE_ERROR 4 +CONSTANT: GDBM_FILE_SEEK_ERROR 5 +CONSTANT: GDBM_FILE_READ_ERROR 6 +CONSTANT: GDBM_BAD_MAGIC_NUMBER 7 +CONSTANT: GDBM_EMPTY_DATABASE 8 +CONSTANT: GDBM_CANT_BE_READER 9 +CONSTANT: GDBM_CANT_BE_WRITER 10 +CONSTANT: GDBM_READER_CANT_DELETE 11 +CONSTANT: GDBM_READER_CANT_STORE 12 +CONSTANT: GDBM_READER_CANT_REORGANIZE 13 +CONSTANT: GDBM_UNKNOWN_UPDATE 14 +CONSTANT: GDBM_ITEM_NOT_FOUND 15 +CONSTANT: GDBM_REORGANIZE_FAILED 16 +CONSTANT: GDBM_CANNOT_REPLACE 17 +CONSTANT: GDBM_ILLEGAL_DATA 18 +CONSTANT: GDBM_OPT_ALREADY_SET 19 +CONSTANT: GDBM_OPT_ILLEGAL 20 + +TYPEDEF: int gdbm_error +C-GLOBAL: gdbm_error gdbm_errno From 4378948e47867d60006df99ffd582f7a2275ce11 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Sun, 13 Jun 2010 06:10:10 +0400 Subject: [PATCH 02/21] gdbm: add higher level interface --- extra/gdbm/authors.txt | 1 + extra/gdbm/ffi/ffi.factor | 4 +- extra/gdbm/gdbm.factor | 85 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 89 insertions(+), 1 deletion(-) create mode 100644 extra/gdbm/authors.txt create mode 100644 extra/gdbm/gdbm.factor diff --git a/extra/gdbm/authors.txt b/extra/gdbm/authors.txt new file mode 100644 index 0000000000..e1702c7130 --- /dev/null +++ b/extra/gdbm/authors.txt @@ -0,0 +1 @@ +Dmitry Shubin diff --git a/extra/gdbm/ffi/ffi.factor b/extra/gdbm/ffi/ffi.factor index cf63b566fb..9776cdd0de 100644 --- a/extra/gdbm/ffi/ffi.factor +++ b/extra/gdbm/ffi/ffi.factor @@ -38,7 +38,7 @@ TYPEDEF: _GDBM_FILE* GDBM_FILE CALLBACK: void fatal_func_cb ; FUNCTION: GDBM_FILE gdbm_open ( c-string name, int block_size, int read_write, int mode, fatal_func_cb fatal_func ) ; -FUNCTION: void gdbm_close ( GDBM_FILE dbf ) ; +FUNCTION-ALIAS: gdbm-close void gdbm_close ( GDBM_FILE dbf ) ; FUNCTION: int gdbm_store ( GDBM_FILE dbf, datum key, datum content, int flag ) ; FUNCTION: datum gdbm_fetch ( GDBM_FILE dbf, datum key ) ; FUNCTION: int gdbm_delete ( GDBM_FILE dbf, datum key ) ; @@ -74,3 +74,5 @@ CONSTANT: GDBM_OPT_ILLEGAL 20 TYPEDEF: int gdbm_error C-GLOBAL: gdbm_error gdbm_errno + +FUNCTION: c-string gdbm_strerror ( gdbm_error errno ) ; diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor new file mode 100644 index 0000000000..55da935aeb --- /dev/null +++ b/extra/gdbm/gdbm.factor @@ -0,0 +1,85 @@ +! Copyright (C) 2010 Dmitry Shubin. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.data alien.destructors +classes.struct combinators destructors gdbm.ffi io.backend kernel libc +literals math namespaces sequences serialize strings ; +IN: gdbm + +: object>datum ( obj -- datum ) + object>bytes [ malloc-byte-array &free ] [ length ] bi + datum ; + +: datum>object* ( datum -- obj ? ) + [ dptr>> ] [ dsize>> ] bi over + [ memory>byte-array bytes>object t ] [ drop f ] if ; + +SYMBOL: current-dbf + +: dbf ( -- dbf ) current-dbf get ; + +TUPLE: gdbm + { name string } + { block-size integer } + { flags integer initial: $ GDBM_WRCREAT } + { mode integer initial: OCT: 644 } ; + +DESTRUCTOR: gdbm-close + +ERROR: gdbm-error errno msg ; + +: gdbm-throw ( -- * ) gdbm_errno dup gdbm_strerror gdbm-error ; + +: check-error ( ret -- ) 0 = [ gdbm-throw ] unless ; + +: gdbm-open ( gdbm -- dbf ) + { + [ name>> normalize-path ] + [ block-size>> ] [ flags>> ] [ mode>> ] + } cleave f gdbm_open [ gdbm-throw ] unless* ; + +: gdbm-store ( key content flag -- ) + [ + { [ dbf ] [ object>datum ] [ object>datum ] [ ] } spread + gdbm_store check-error + ] with-destructors ; + +: gdbm-replace ( key content -- ) GDBM_REPLACE gdbm-store ; + +: gdbm-insert ( key content -- ) GDBM_INSERT gdbm-store ; + +: gdbm-fetch* ( key -- content ? ) + [ dbf swap object>datum gdbm_fetch datum>object* ] + with-destructors ; + +: gdbm-fetch ( key -- content/f ) gdbm-fetch* drop ; + +: gdbm-delete ( key -- ) + [ dbf swap object>datum gdbm_delete check-error ] + with-destructors ; + +: gdbm-firstkey* ( -- key ? ) + [ dbf gdbm_firstkey datum>object* ] with-destructors ; + +: gdbm-firstkey ( -- key/f ) gdbm-firstkey* drop ; + +: gdbm-nextkey* ( key -- key ? ) + [ dbf swap object>datum gdbm_nextkey datum>object* ] + with-destructors ; + +: gdbm-nextkey ( key -- key/f ) gdbm-nextkey* drop ; + +: gdbm-reorganize ( -- ) dbf gdbm_reorganize check-error ; + +: gdbm-sync ( -- ) dbf gdbm_sync ; + +: gdbm-exists ( key -- ? ) + [ dbf swap object>datum gdbm_exists c-bool> ] + with-destructors ; + +! : gdbm-setopt ( option value size -- ret ) ; + +: gdbm-fdesc ( -- desc ) dbf gdbm_fdesc ; + +: with-gdbm ( gdbm quot -- ) + [ gdbm-open &gdbm-close current-dbf set ] prepose curry + [ with-scope ] curry with-destructors ; inline From 01a62e25eb18149198fa824dba23e4e88b5c6396 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Mon, 14 Jun 2010 00:37:40 +0400 Subject: [PATCH 03/21] gdbm: code cleanup --- extra/gdbm/gdbm.factor | 75 ++++++++++++++++++++++-------------------- 1 file changed, 39 insertions(+), 36 deletions(-) diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 55da935aeb..642d0d3aeb 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -5,6 +5,33 @@ classes.struct combinators destructors gdbm.ffi io.backend kernel libc literals math namespaces sequences serialize strings ; IN: gdbm +TUPLE: gdbm + { name string } + { block-size integer } + { flags integer initial: $ GDBM_WRCREAT } + { mode integer initial: OCT: 644 } ; + +ERROR: gdbm-error errno msg ; + + +> normalize-path ] + [ block-size>> ] [ flags>> ] [ mode>> ] + } cleave f gdbm_open [ gdbm-throw ] unless* ; + +DESTRUCTOR: gdbm-close + : object>datum ( obj -- datum ) object>bytes [ malloc-byte-array &free ] [ length ] bi datum ; @@ -13,60 +40,36 @@ IN: gdbm [ dptr>> ] [ dsize>> ] bi over [ memory>byte-array bytes>object t ] [ drop f ] if ; -SYMBOL: current-dbf - -: dbf ( -- dbf ) current-dbf get ; - -TUPLE: gdbm - { name string } - { block-size integer } - { flags integer initial: $ GDBM_WRCREAT } - { mode integer initial: OCT: 644 } ; - -DESTRUCTOR: gdbm-close - -ERROR: gdbm-error errno msg ; - -: gdbm-throw ( -- * ) gdbm_errno dup gdbm_strerror gdbm-error ; - -: check-error ( ret -- ) 0 = [ gdbm-throw ] unless ; - -: gdbm-open ( gdbm -- dbf ) - { - [ name>> normalize-path ] - [ block-size>> ] [ flags>> ] [ mode>> ] - } cleave f gdbm_open [ gdbm-throw ] unless* ; - : gdbm-store ( key content flag -- ) [ { [ dbf ] [ object>datum ] [ object>datum ] [ ] } spread gdbm_store check-error ] with-destructors ; +PRIVATE> + + : gdbm-replace ( key content -- ) GDBM_REPLACE gdbm-store ; - : gdbm-insert ( key content -- ) GDBM_INSERT gdbm-store ; -: gdbm-fetch* ( key -- content ? ) - [ dbf swap object>datum gdbm_fetch datum>object* ] - with-destructors ; - -: gdbm-fetch ( key -- content/f ) gdbm-fetch* drop ; - : gdbm-delete ( key -- ) [ dbf swap object>datum gdbm_delete check-error ] with-destructors ; -: gdbm-firstkey* ( -- key ? ) +: gdbm-fetch* ( key -- content ? ) + [ dbf swap object>datum gdbm_fetch datum>object* ] + with-destructors ; + +: gdbm-first-key* ( -- key ? ) [ dbf gdbm_firstkey datum>object* ] with-destructors ; -: gdbm-firstkey ( -- key/f ) gdbm-firstkey* drop ; - -: gdbm-nextkey* ( key -- key ? ) +: gdbm-next-key* ( key -- key ? ) [ dbf swap object>datum gdbm_nextkey datum>object* ] with-destructors ; -: gdbm-nextkey ( key -- key/f ) gdbm-nextkey* drop ; +: gdbm-fetch ( key -- content/f ) gdbm-fetch* drop ; +: gdbm-first-key ( -- key/f ) gdbm-first-key* drop ; +: gdbm-next-key ( key -- key/f ) gdbm-next-key* drop ; : gdbm-reorganize ( -- ) dbf gdbm_reorganize check-error ; From 77465c875541eddbe7c2986ab846e14c520a0264 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Wed, 16 Jun 2010 19:40:33 +0400 Subject: [PATCH 04/21] gdbm: better exception handling --- extra/gdbm/ffi/ffi.factor | 22 --------------- extra/gdbm/gdbm.factor | 56 +++++++++++++++++++++++++++++++++++---- 2 files changed, 51 insertions(+), 27 deletions(-) diff --git a/extra/gdbm/ffi/ffi.factor b/extra/gdbm/ffi/ffi.factor index 9776cdd0de..142e2ae2f7 100644 --- a/extra/gdbm/ffi/ffi.factor +++ b/extra/gdbm/ffi/ffi.factor @@ -50,28 +50,6 @@ FUNCTION: int gdbm_exists ( GDBM_FILE dbf, datum key ) ; FUNCTION: int gdbm_setopt ( GDBM_FILE dbf, int option, int* value, int size ) ; FUNCTION: int gdbm_fdesc ( GDBM_FILE dbf ) ; -CONSTANT: GDBM_NO_ERROR 0 -CONSTANT: GDBM_MALLOC_ERROR 1 -CONSTANT: GDBM_BLOCK_SIZE_ERROR 2 -CONSTANT: GDBM_FILE_OPEN_ERROR 3 -CONSTANT: GDBM_FILE_WRITE_ERROR 4 -CONSTANT: GDBM_FILE_SEEK_ERROR 5 -CONSTANT: GDBM_FILE_READ_ERROR 6 -CONSTANT: GDBM_BAD_MAGIC_NUMBER 7 -CONSTANT: GDBM_EMPTY_DATABASE 8 -CONSTANT: GDBM_CANT_BE_READER 9 -CONSTANT: GDBM_CANT_BE_WRITER 10 -CONSTANT: GDBM_READER_CANT_DELETE 11 -CONSTANT: GDBM_READER_CANT_STORE 12 -CONSTANT: GDBM_READER_CANT_REORGANIZE 13 -CONSTANT: GDBM_UNKNOWN_UPDATE 14 -CONSTANT: GDBM_ITEM_NOT_FOUND 15 -CONSTANT: GDBM_REORGANIZE_FAILED 16 -CONSTANT: GDBM_CANNOT_REPLACE 17 -CONSTANT: GDBM_ILLEGAL_DATA 18 -CONSTANT: GDBM_OPT_ALREADY_SET 19 -CONSTANT: GDBM_OPT_ILLEGAL 20 - TYPEDEF: int gdbm_error C-GLOBAL: gdbm_error gdbm_errno diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 642d0d3aeb..28aa9b35f2 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2010 Dmitry Shubin. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.data alien.destructors -classes.struct combinators destructors gdbm.ffi io.backend kernel libc -literals math namespaces sequences serialize strings ; +USING: accessors alien.c-types alien.data alien.destructors assocs +biassocs classes.struct combinators destructors gdbm.ffi io.backend +kernel libc literals math namespaces sequences serialize strings ; IN: gdbm TUPLE: gdbm @@ -11,15 +11,59 @@ TUPLE: gdbm { flags integer initial: $ GDBM_WRCREAT } { mode integer initial: OCT: 644 } ; -ERROR: gdbm-error errno msg ; +SINGLETONS: + gdbm-no-error gdbm-malloc-error + gdbm-block-size-error gdbm-file-open-error + gdbm-file-write-error gdbm-file-seek-error + gdbm-file-read-error gdbm-bad-magic-number + gdbm-empty-database gdbm-cant-be-reader + gdbm-cant-be-writer gdbm-reader-cant-delete + gdbm-reader-cant-store gdbm-reader-cant-reorganize + gdbm-unknown-update gdbm-item-not-found + gdbm-reorganize-failed gdbm-cannot-replace + gdbm-illegal-data gdbm-option-already-set + gdbm-illegal-option ; + +ERROR: gdbm-unknown-error error ; biassoc ; + +: error>code ( error -- code ) + dup error-table value-at [ ] [ gdbm-unknown-error ] ?if ; + +: code>error ( code -- error ) error-table at ; + +: gdbm-throw ( -- * ) gdbm_errno code>error throw ; : check-error ( ret -- ) 0 = [ gdbm-throw ] unless ; + SYMBOL: current-dbf : dbf ( -- dbf ) current-dbf get ; @@ -49,6 +93,8 @@ DESTRUCTOR: gdbm-close PRIVATE> +: gdbm-error-message ( error -- msg ) error>code gdbm_strerror ; + : gdbm-replace ( key content -- ) GDBM_REPLACE gdbm-store ; : gdbm-insert ( key content -- ) GDBM_INSERT gdbm-store ; From cb361af8b48b6436ff9a1e34def7d0cafa272133 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Thu, 17 Jun 2010 03:51:28 +0400 Subject: [PATCH 05/21] gdbm: implement gdbm-setopt --- extra/gdbm/gdbm.factor | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 28aa9b35f2..2f052a3872 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types alien.data alien.destructors assocs biassocs classes.struct combinators destructors gdbm.ffi io.backend -kernel libc literals math namespaces sequences serialize strings ; +kernel libc literals locals math namespaces sequences serialize +strings ; IN: gdbm TUPLE: gdbm @@ -125,7 +126,19 @@ PRIVATE> [ dbf swap object>datum gdbm_exists c-bool> ] with-destructors ; -! : gdbm-setopt ( option value size -- ret ) ; + ( size ptr ) + value ptr 0 int set-alien-value + dbf option ptr size gdbm_setopt check-error + ] with-destructors ; + +PRIVATE> + +: gdbm-setopt ( option value -- ) + over GDBM_CACHESIZE = [ >c-bool ] unless (gdbm-setopt) ; : gdbm-fdesc ( -- desc ) dbf gdbm_fdesc ; From 09dbdaae7703e925c085829b4fbef21b85331930 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Sat, 26 Jun 2010 22:06:35 +0400 Subject: [PATCH 06/21] gdbm: switch back to simpler error handling scheme --- extra/gdbm/ffi/ffi.factor | 28 +++++++++++++-- extra/gdbm/gdbm.factor | 75 +++++++-------------------------------- 2 files changed, 37 insertions(+), 66 deletions(-) diff --git a/extra/gdbm/ffi/ffi.factor b/extra/gdbm/ffi/ffi.factor index 142e2ae2f7..382315b4fe 100644 --- a/extra/gdbm/ffi/ffi.factor +++ b/extra/gdbm/ffi/ffi.factor @@ -50,7 +50,29 @@ FUNCTION: int gdbm_exists ( GDBM_FILE dbf, datum key ) ; FUNCTION: int gdbm_setopt ( GDBM_FILE dbf, int option, int* value, int size ) ; FUNCTION: int gdbm_fdesc ( GDBM_FILE dbf ) ; -TYPEDEF: int gdbm_error -C-GLOBAL: gdbm_error gdbm_errno +ENUM: gdbm-error + gdbm-no-error + gdbm-malloc-error + gdbm-block-size-error + gdbm-file-open-error + gdbm-file-write-error + gdbm-file-seek-error + gdbm-file-read-error + gdbm-bad-magic-number + gdbm-empty-database + gdbm-cant-be-reader + gdbm-cant-be-writer + gdbm-reader-cant-delete + gdbm-reader-cant-store + gdbm-reader-cant-reorganize + gdbm-unknown-update + gdbm-item-not-found + gdbm-reorganize-failed + gdbm-cannot-replace + gdbm-illegal-data + gdbm-option-already-set + gdbm-illegal-option ; -FUNCTION: c-string gdbm_strerror ( gdbm_error errno ) ; +C-GLOBAL: gdbm-error gdbm_errno + +FUNCTION: c-string gdbm_strerror ( gdbm-error errno ) ; diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 2f052a3872..bc3ac33d8b 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2010 Dmitry Shubin. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.data alien.destructors assocs -biassocs classes.struct combinators destructors gdbm.ffi io.backend -kernel libc literals locals math namespaces sequences serialize -strings ; +USING: accessors alien.c-types alien.data alien.destructors +classes.struct combinators destructors gdbm.ffi io.backend kernel libc +literals locals math namespaces sequences serialize strings ; IN: gdbm TUPLE: gdbm @@ -12,59 +11,13 @@ TUPLE: gdbm { flags integer initial: $ GDBM_WRCREAT } { mode integer initial: OCT: 644 } ; -SINGLETONS: - gdbm-no-error gdbm-malloc-error - gdbm-block-size-error gdbm-file-open-error - gdbm-file-write-error gdbm-file-seek-error - gdbm-file-read-error gdbm-bad-magic-number - gdbm-empty-database gdbm-cant-be-reader - gdbm-cant-be-writer gdbm-reader-cant-delete - gdbm-reader-cant-store gdbm-reader-cant-reorganize - gdbm-unknown-update gdbm-item-not-found - gdbm-reorganize-failed gdbm-cannot-replace - gdbm-illegal-data gdbm-option-already-set - gdbm-illegal-option ; - -ERROR: gdbm-unknown-error error ; - biassoc ; - -: error>code ( error -- code ) - dup error-table value-at [ ] [ gdbm-unknown-error ] ?if ; - -: code>error ( code -- error ) error-table at ; - -: gdbm-throw ( -- * ) gdbm_errno code>error throw ; +: gdbm-throw ( -- * ) gdbm_errno throw ; : check-error ( ret -- ) 0 = [ gdbm-throw ] unless ; - SYMBOL: current-dbf : dbf ( -- dbf ) current-dbf get ; @@ -91,10 +44,17 @@ DESTRUCTOR: gdbm-close gdbm_store check-error ] with-destructors ; +:: (gdbm-setopt) ( option value -- ) + [ + int heap-size dup malloc &free :> ( size ptr ) + value ptr 0 int set-alien-value + dbf option ptr size gdbm_setopt check-error + ] with-destructors ; + PRIVATE> -: gdbm-error-message ( error -- msg ) error>code gdbm_strerror ; +ALIAS: gdbm-error-message gdbm_strerror : gdbm-replace ( key content -- ) GDBM_REPLACE gdbm-store ; : gdbm-insert ( key content -- ) GDBM_INSERT gdbm-store ; @@ -126,17 +86,6 @@ PRIVATE> [ dbf swap object>datum gdbm_exists c-bool> ] with-destructors ; - ( size ptr ) - value ptr 0 int set-alien-value - dbf option ptr size gdbm_setopt check-error - ] with-destructors ; - -PRIVATE> - : gdbm-setopt ( option value -- ) over GDBM_CACHESIZE = [ >c-bool ] unless (gdbm-setopt) ; From d1d742211beb48ba5bb86bf2aa91ce7d82665e70 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Sat, 26 Jun 2010 22:24:27 +0400 Subject: [PATCH 07/21] gdbm: remove obsolete options --- extra/gdbm/ffi/ffi.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/extra/gdbm/ffi/ffi.factor b/extra/gdbm/ffi/ffi.factor index 382315b4fe..a6abc86e54 100644 --- a/extra/gdbm/ffi/ffi.factor +++ b/extra/gdbm/ffi/ffi.factor @@ -18,7 +18,6 @@ CONSTANT: GDBM_READER 0 CONSTANT: GDBM_WRITER 1 CONSTANT: GDBM_WRCREAT 2 CONSTANT: GDBM_NEWDB 3 -CONSTANT: GDBM_FAST HEX: 10 CONSTANT: GDBM_SYNC HEX: 20 CONSTANT: GDBM_NOLOCK HEX: 40 @@ -26,7 +25,6 @@ CONSTANT: GDBM_INSERT 0 CONSTANT: GDBM_REPLACE 1 CONSTANT: GDBM_CACHESIZE 1 -CONSTANT: GDBM_FASTMODE 2 CONSTANT: GDBM_SYNCMODE 3 CONSTANT: GDBM_CENTFREE 4 CONSTANT: GDBM_COALESCEBLKS 5 From 9a1a60f8043092d007f711f23d6e070e1a22de4f Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Sat, 26 Jun 2010 23:00:00 +0400 Subject: [PATCH 08/21] gdbm: better option setters --- extra/gdbm/gdbm.factor | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index bc3ac33d8b..6145211e4b 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -44,13 +44,16 @@ DESTRUCTOR: gdbm-close gdbm_store check-error ] with-destructors ; -:: (gdbm-setopt) ( option value -- ) +:: (setopt) ( value option -- ) [ int heap-size dup malloc &free :> ( size ptr ) value ptr 0 int set-alien-value dbf option ptr size gdbm_setopt check-error ] with-destructors ; +: setopt ( value option -- ) + [ GDBM_CACHESIZE = [ >c-bool ] unless ] keep (setopt) ; + PRIVATE> @@ -86,8 +89,10 @@ ALIAS: gdbm-error-message gdbm_strerror [ dbf swap object>datum gdbm_exists c-bool> ] with-destructors ; -: gdbm-setopt ( option value -- ) - over GDBM_CACHESIZE = [ >c-bool ] unless (gdbm-setopt) ; +: gdbm-set-cache-size ( size -- ) GDBM_CACHESIZE setopt ; +: gdbm-set-sync-mode ( ? -- ) GDBM_SYNCMODE setopt ; +: gdbm-set-block-pool ( ? -- ) GDBM_CENTFREE setopt ; +: gdbm-set-block-merging ( ? -- ) GDBM_COALESCEBLKS setopt ; : gdbm-fdesc ( -- desc ) dbf gdbm_fdesc ; From 4720a1aad3a728e1d4558b33a324e86107b8c90b Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Sun, 27 Jun 2010 01:29:47 +0400 Subject: [PATCH 09/21] gdbm: more user-friendly initial configuration --- extra/gdbm/ffi/ffi.factor | 6 ++---- extra/gdbm/gdbm.factor | 20 ++++++++++++++------ 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/extra/gdbm/ffi/ffi.factor b/extra/gdbm/ffi/ffi.factor index a6abc86e54..307f749cb4 100644 --- a/extra/gdbm/ffi/ffi.factor +++ b/extra/gdbm/ffi/ffi.factor @@ -14,10 +14,8 @@ LIBRARY: libgdbm C-GLOBAL: c-string gdbm_version -CONSTANT: GDBM_READER 0 -CONSTANT: GDBM_WRITER 1 -CONSTANT: GDBM_WRCREAT 2 -CONSTANT: GDBM_NEWDB 3 +ENUM: gdbm-role reader writer wrcreat newdb ; + CONSTANT: GDBM_SYNC HEX: 20 CONSTANT: GDBM_NOLOCK HEX: 40 diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 6145211e4b..4c035b4faa 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -1,15 +1,17 @@ ! Copyright (C) 2010 Dmitry Shubin. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types alien.data alien.destructors -classes.struct combinators destructors gdbm.ffi io.backend kernel libc -literals locals math namespaces sequences serialize strings ; +alien.enums classes.struct combinators destructors gdbm.ffi io.backend +kernel libc locals math namespaces sequences serialize strings ; IN: gdbm TUPLE: gdbm - { name string } + { name string } { block-size integer } - { flags integer initial: $ GDBM_WRCREAT } - { mode integer initial: OCT: 644 } ; + { role initial: wrcreat } + { sync boolean } + { nolock boolean } + { mode integer initial: OCT: 644 } ; > enum>number ] + [ sync>> GDBM_SYNC 0 ? ] + [ nolock>> GDBM_NOLOCK 0 ? ] + tri bitor bitor ; + : gdbm-open ( gdbm -- dbf ) { [ name>> normalize-path ] - [ block-size>> ] [ flags>> ] [ mode>> ] + [ block-size>> ] [ get-flag ] [ mode>> ] } cleave f gdbm_open [ gdbm-throw ] unless* ; DESTRUCTOR: gdbm-close From d14bf0736d14226c9d47883e7d5bef952d527e78 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Sun, 27 Jun 2010 17:40:22 +0400 Subject: [PATCH 10/21] gdbm: add constructor --- extra/gdbm/gdbm.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 4c035b4faa..4c19cb28ff 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -13,6 +13,8 @@ TUPLE: gdbm { nolock boolean } { mode integer initial: OCT: 644 } ; +: ( -- gdbm ) gdbm new ; + Date: Sun, 27 Jun 2010 20:35:46 +0400 Subject: [PATCH 11/21] gdbm: fix stack effect comment --- extra/gdbm/gdbm.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 4c19cb28ff..a619a9f3d0 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -83,7 +83,7 @@ ALIAS: gdbm-error-message gdbm_strerror : gdbm-first-key* ( -- key ? ) [ dbf gdbm_firstkey datum>object* ] with-destructors ; -: gdbm-next-key* ( key -- key ? ) +: gdbm-next-key* ( key -- next-key ? ) [ dbf swap object>datum gdbm_nextkey datum>object* ] with-destructors ; From ce2ba6a271e298aaa89fd3ecb149705a035d88b2 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Sun, 27 Jun 2010 23:56:20 +0400 Subject: [PATCH 12/21] gdbm: replace ALIAS: with normal definition for documentation's sake --- extra/gdbm/gdbm.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index a619a9f3d0..90aaa7fade 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -67,7 +67,7 @@ DESTRUCTOR: gdbm-close PRIVATE> -ALIAS: gdbm-error-message gdbm_strerror +: gdbm-error-message ( error -- msg ) gdbm_strerror ; : gdbm-replace ( key content -- ) GDBM_REPLACE gdbm-store ; : gdbm-insert ( key content -- ) GDBM_INSERT gdbm-store ; From 66102b763b482b72675caa28a19b11975f2e909f Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Mon, 28 Jun 2010 00:00:19 +0400 Subject: [PATCH 13/21] gdbm: add documentation --- extra/gdbm/gdbm-docs.factor | 129 ++++++++++++++++++++++++++++++++++++ 1 file changed, 129 insertions(+) create mode 100644 extra/gdbm/gdbm-docs.factor diff --git a/extra/gdbm/gdbm-docs.factor b/extra/gdbm/gdbm-docs.factor new file mode 100644 index 0000000000..924fcb1ad2 --- /dev/null +++ b/extra/gdbm/gdbm-docs.factor @@ -0,0 +1,129 @@ +! Copyright (C) 2010 Dmitry Shubin. +! See http://factorcode.org/license.txt for BSD license. +USING: gdbm.ffi gdbm.private help.markup help.syntax kernel math +quotations strings ; +IN: gdbm + +HELP: gdbm +{ $class-description "Instance of this class is used as database configuration object. It has following slots:" + + { $table + { { $slot "name" } "The file name of the database." } + { { $slot "block-size" } "The size of a single transfer from disk to memory. If the value is less than 512, the file system blocksize is used (this is default)." } + { { $slot "role" } "Determines what kind of access the user wants to obtain (see below)." } + { { $slot "sync" } { "Being set to " { $link t } " causes all database operations to be synchronized to the disk." } } + { { $slot "nolock" } { "Being set to " { $link t } " prevents gdbm from performing any locking on the database file." } } + { { $slot "mode" } "An integer representing standard UNIX access permissions." } + } + "The " { $slot "role" } " can be set to one of the folowing values:" + { $table + { { $snippet "reader" } "The user can only read from existing database." } + { { $snippet "writer" } "The user can access existing database as reader and writer." } + { { $snippet "wrcreat" } "Open the database for reading and writing if it exists and create new one otherwise." } + { { $snippet "newdb" } "Create empty database even if there is already one with the same name." } + } +} ; + +HELP: +{ $values { "gdbm" gdbm } } +{ $description "Creates database configuration object with all slots set to their default values. See " { $link gdbm } " for complete slots description." } ; + +HELP: gdbm-delete +{ $values { "key" object } } +{ $description "Removes the keyed item from the database." } ; + +HELP: gdbm-error-message +{ $values { "error" gdbm-error } { "msg" string } } +{ $description "Returns error message in human readable format." } ; + +HELP: gdbm-exists +{ $values { "key" object } { "?" boolean } } +{ $description "Searches for a particular key without retreiving it." } ; + +HELP: gdbm-fdesc +{ $values { "desc" integer } } +{ $description "Returns the file descriptor of the database. This is used for manual database locking if it was opened with " { $snippet "nolock" } " flag set to " { $link t } "." } ; + +HELP: gdbm-fetch +{ $values + { "key" object } + { "content/f" { "the value associated with " { $snippet "key" } " or " { $link f } " if there is no such key" } } +} +{ $description "Looks up a given key and returns value associated with it. This word makes no distinction between a missing value and a value set to " { $link f } "." } ; + +HELP: gdbm-fetch* +{ $values { "key" object } { "content" object } { "?" boolean } } +{ $description "Looks up a given key and returns value associated with it. The boolean flag can decide between the case of a missing value, and a value of " { $link f } "." } ; + +HELP: gdbm-first-key +{ $values { "key/f" object } } +{ $description "Returns first key in the database. This word makes no distinction between an empty database case and a case of a first value set to " { $link f } "." } ; + +HELP: gdbm-first-key* +{ $values { "key" object } { "?" boolean } } +{ $description "Returns first key in the database. The boolean flag can decide between the case of an empty database and a case of a first value set to " { $link f } "." } ; + +HELP: gdbm-insert +{ $values { "key" object } { "content" object } } +{ $description "Inserts record into the database. Throws an error if the key already exists." } ; + +HELP: gdbm-next-key +{ $values { "key" object } { "key/f" object } } +{ $description "Given a key returns next key in the database. This word makes no distinction between reaching the end of the database case and a case of a next value set to " { $link f } "." } ; + +HELP: gdbm-next-key* +{ $values { "key" object } { "next-key" object } { "?" boolean } } +{ $description "Given a key returns next key in the database. The boolean flag can decide between the case of reaching the end of the database and a case of a next value set to " { $link f } "." } ; + +HELP: gdbm-reorganize +{ $description "Reorganisation is a process of shinking the space used by gdbm. This requires creating a new file and moving all elements from old gdbm file to new one." } ; + +HELP: gdbm-replace +{ $values { "key" object } { "content" object } } +{ $description "Inserts record into the database replacing old value with the new one if the key already exists." } ; + +HELP: gdbm-set-block-merging +{ $values { "?" boolean } } +{ $description "If set, this option causes adjacent free blocks to be merged. The default is " { $link f } "." } ; + +HELP: gdbm-set-block-pool +{ $values { "?" boolean } } +{ $description "If set, this option causes all subsequent free blocks to be placed in the global pool. The default is " { $link f } "." } ; + +HELP: gdbm-set-cache-size +{ $values { "size" integer } } +{ $description "Sets the size of the internal bucket cache. The default value is 100." } ; + +HELP: gdbm-set-sync-mode +{ $values { "?" boolean } } +{ $description "Turns on or off file system synchronization. The default is " { $link f } "." } ; + +HELP: gdbm-sync +{ $description "Performs database synchronization: make sure the disk version of the database has been completely updated." } ; + +HELP: with-gdbm +{ $values + { "gdbm" "a database configuration object" } { "quot" quotation } +} +{ $description "Calls the quotation with a database bound to " { $link current-dbf } " symbol." } ; + + +ARTICLE: "gdbm" "GNU Database Manager" +"The " { $vocab-link "gdbm" } " vocabulary provides an interface to GNU DataBase Manager. This is a GNU implementation of the standard Unix dbm library, originally developed at Berkeley." + +$nl +"This is a very brief manual. For a more detailed description consult the official gdbm documentation." + +{ $heading "Basics" } +"All interaction with gdbm database should be realized using special combinator which automates all work for database initialisation and cleanup. All initialisation options are passed to combinator with a database configuration object." +{ $subsections gdbm with-gdbm } +"For actual record manipulation the following words are used:" +{ $subsections gdbm-insert gdbm-exists gdbm-fetch gdbm-delete } + +{ $heading "Sequential access" } +"It is possible to iterate through all records in the database with." +{ $subsections gdbm-first-key gdbm-next-key } +"The order in which records are accessed has nothing to do with the order in which records have been stored. Note that these words can only be used in read-only algorithms since delete operation re-arranges the hash table." +; + +ABOUT: "gdbm" From e16f6e816fb7ed7d60c3e2eb1c7394c7b64470e5 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Mon, 28 Jun 2010 01:45:05 +0400 Subject: [PATCH 14/21] gdbm: add unit tests --- extra/gdbm/gdbm-tests.factor | 67 ++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) create mode 100644 extra/gdbm/gdbm-tests.factor diff --git a/extra/gdbm/gdbm-tests.factor b/extra/gdbm/gdbm-tests.factor new file mode 100644 index 0000000000..ab3cb912f6 --- /dev/null +++ b/extra/gdbm/gdbm-tests.factor @@ -0,0 +1,67 @@ +! Copyright (C) 2010 Dmitry Shubin. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors continuations gdbm gdbm.ffi io.directories +io.files.temp kernel sequences sets tools.test ; +IN: gdbm.tests + +: db-path ( -- filename ) "test.db" temp-file ; + +: CLEANUP ( -- ) [ db-path delete-file ] ignore-errors ; + +: test.db ( -- gdbm ) db-path >>name ; + +: with-test.db ( quot -- ) test.db swap with-gdbm ; inline + + +CLEANUP + + +[ + test.db reader >>role [ ] with-gdbm +] [ gdbm-file-open-error = ] must-fail-with + +[ f ] [ [ "foo" gdbm-exists ] with-test.db ] unit-test + +[ ] [ [ "foo" 41 gdbm-insert ] with-test.db ] unit-test + +[ + [ "foo" 42 gdbm-insert ] with-test.db +] [ gdbm-cannot-replace = ] must-fail-with + +[ ] +[ + [ + "foo" 42 gdbm-replace + "bar" 43 gdbm-replace + "baz" 44 gdbm-replace + ] with-test.db +] unit-test + +[ 42 t ] [ [ "foo" gdbm-fetch* ] with-test.db ] unit-test + +[ f f ] [ [ "unknown" gdbm-fetch* ] with-test.db ] unit-test + +[ + [ + 300 gdbm-set-cache-size 300 gdbm-set-cache-size + ] with-test.db +] [ gdbm-option-already-set = ] must-fail-with + +[ t ] +[ + V{ } + [ + gdbm-first-key + [ gdbm-next-key* ] [ [ swap push ] 2keep ] do while drop + ] with-test.db + V{ "foo" "bar" "baz" } set= + +] unit-test + +[ f ] +[ + test.db newdb >>role [ "foo" gdbm-exists ] with-gdbm +] unit-test + + +CLEANUP From cab257bbea2b9e24ba6f881d7f0c87c18e5168de Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Mon, 28 Jun 2010 01:46:20 +0400 Subject: [PATCH 15/21] gdbm: documentation addendum --- extra/gdbm/gdbm-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/gdbm/gdbm-docs.factor b/extra/gdbm/gdbm-docs.factor index 924fcb1ad2..7a00e214c3 100644 --- a/extra/gdbm/gdbm-docs.factor +++ b/extra/gdbm/gdbm-docs.factor @@ -92,7 +92,7 @@ HELP: gdbm-set-block-pool HELP: gdbm-set-cache-size { $values { "size" integer } } -{ $description "Sets the size of the internal bucket cache. The default value is 100." } ; +{ $description "Sets the size of the internal bucket cache. The default value is 100. This option may only be set once." } ; HELP: gdbm-set-sync-mode { $values { "?" boolean } } From 2992a37fe5e0a4c5f8bf3fef60ffa74854f7b425 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Mon, 28 Jun 2010 01:52:36 +0400 Subject: [PATCH 16/21] gdbm: add gdbm-info --- extra/gdbm/gdbm-docs.factor | 4 ++++ extra/gdbm/gdbm.factor | 2 ++ 2 files changed, 6 insertions(+) diff --git a/extra/gdbm/gdbm-docs.factor b/extra/gdbm/gdbm-docs.factor index 7a00e214c3..80735145f2 100644 --- a/extra/gdbm/gdbm-docs.factor +++ b/extra/gdbm/gdbm-docs.factor @@ -28,6 +28,10 @@ HELP: { $values { "gdbm" gdbm } } { $description "Creates database configuration object with all slots set to their default values. See " { $link gdbm } " for complete slots description." } ; +HELP: gdbm-info +{ $values { "str" string } } +{ $description "Returns version number and build date." } ; + HELP: gdbm-delete { $values { "key" object } } { $description "Removes the keyed item from the database." } ; diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 90aaa7fade..7993864643 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -67,6 +67,8 @@ DESTRUCTOR: gdbm-close PRIVATE> +: gdbm-info ( -- str ) gdbm_version ; + : gdbm-error-message ( error -- msg ) gdbm_strerror ; : gdbm-replace ( key content -- ) GDBM_REPLACE gdbm-store ; From 8790c73a266dd6ffd0e48712766e8654dbf8dfe0 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Mon, 28 Jun 2010 02:14:50 +0400 Subject: [PATCH 17/21] gdbm: add metadata --- extra/gdbm/summary.txt | 1 + extra/gdbm/tags.txt | 2 ++ 2 files changed, 3 insertions(+) create mode 100644 extra/gdbm/summary.txt create mode 100644 extra/gdbm/tags.txt diff --git a/extra/gdbm/summary.txt b/extra/gdbm/summary.txt new file mode 100644 index 0000000000..85056ecaef --- /dev/null +++ b/extra/gdbm/summary.txt @@ -0,0 +1 @@ +GNU DataBase Manager diff --git a/extra/gdbm/tags.txt b/extra/gdbm/tags.txt new file mode 100644 index 0000000000..2e60f4bec8 --- /dev/null +++ b/extra/gdbm/tags.txt @@ -0,0 +1,2 @@ +bindings +database From 6705f4f466cae9e1d1d862fea76acce9c7b5fdee Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Mon, 28 Jun 2010 02:17:11 +0400 Subject: [PATCH 18/21] gdbm: drop "gdbm-" prefix --- extra/gdbm/gdbm-docs.factor | 38 ++++++++++++++++++------------------ extra/gdbm/gdbm-tests.factor | 24 +++++++++++------------ extra/gdbm/gdbm.factor | 34 ++++++++++++++++---------------- 3 files changed, 48 insertions(+), 48 deletions(-) diff --git a/extra/gdbm/gdbm-docs.factor b/extra/gdbm/gdbm-docs.factor index 80735145f2..e712da3c99 100644 --- a/extra/gdbm/gdbm-docs.factor +++ b/extra/gdbm/gdbm-docs.factor @@ -32,7 +32,7 @@ HELP: gdbm-info { $values { "str" string } } { $description "Returns version number and build date." } ; -HELP: gdbm-delete +HELP: delete { $values { "key" object } } { $description "Removes the keyed item from the database." } ; @@ -40,69 +40,69 @@ HELP: gdbm-error-message { $values { "error" gdbm-error } { "msg" string } } { $description "Returns error message in human readable format." } ; -HELP: gdbm-exists +HELP: exists? { $values { "key" object } { "?" boolean } } { $description "Searches for a particular key without retreiving it." } ; -HELP: gdbm-fdesc +HELP: gdbm-file-descriptor { $values { "desc" integer } } { $description "Returns the file descriptor of the database. This is used for manual database locking if it was opened with " { $snippet "nolock" } " flag set to " { $link t } "." } ; -HELP: gdbm-fetch +HELP: fetch { $values { "key" object } { "content/f" { "the value associated with " { $snippet "key" } " or " { $link f } " if there is no such key" } } } { $description "Looks up a given key and returns value associated with it. This word makes no distinction between a missing value and a value set to " { $link f } "." } ; -HELP: gdbm-fetch* +HELP: fetch* { $values { "key" object } { "content" object } { "?" boolean } } { $description "Looks up a given key and returns value associated with it. The boolean flag can decide between the case of a missing value, and a value of " { $link f } "." } ; -HELP: gdbm-first-key +HELP: first-key { $values { "key/f" object } } { $description "Returns first key in the database. This word makes no distinction between an empty database case and a case of a first value set to " { $link f } "." } ; -HELP: gdbm-first-key* +HELP: first-key* { $values { "key" object } { "?" boolean } } { $description "Returns first key in the database. The boolean flag can decide between the case of an empty database and a case of a first value set to " { $link f } "." } ; -HELP: gdbm-insert +HELP: insert { $values { "key" object } { "content" object } } { $description "Inserts record into the database. Throws an error if the key already exists." } ; -HELP: gdbm-next-key +HELP: next-key { $values { "key" object } { "key/f" object } } { $description "Given a key returns next key in the database. This word makes no distinction between reaching the end of the database case and a case of a next value set to " { $link f } "." } ; -HELP: gdbm-next-key* +HELP: next-key* { $values { "key" object } { "next-key" object } { "?" boolean } } { $description "Given a key returns next key in the database. The boolean flag can decide between the case of reaching the end of the database and a case of a next value set to " { $link f } "." } ; -HELP: gdbm-reorganize +HELP: reorganize { $description "Reorganisation is a process of shinking the space used by gdbm. This requires creating a new file and moving all elements from old gdbm file to new one." } ; -HELP: gdbm-replace +HELP: replace { $values { "key" object } { "content" object } } { $description "Inserts record into the database replacing old value with the new one if the key already exists." } ; -HELP: gdbm-set-block-merging +HELP: set-block-merging { $values { "?" boolean } } { $description "If set, this option causes adjacent free blocks to be merged. The default is " { $link f } "." } ; -HELP: gdbm-set-block-pool +HELP: set-block-pool { $values { "?" boolean } } { $description "If set, this option causes all subsequent free blocks to be placed in the global pool. The default is " { $link f } "." } ; -HELP: gdbm-set-cache-size +HELP: set-cache-size { $values { "size" integer } } { $description "Sets the size of the internal bucket cache. The default value is 100. This option may only be set once." } ; -HELP: gdbm-set-sync-mode +HELP: set-sync-mode { $values { "?" boolean } } { $description "Turns on or off file system synchronization. The default is " { $link f } "." } ; -HELP: gdbm-sync +HELP: synchronize { $description "Performs database synchronization: make sure the disk version of the database has been completely updated." } ; HELP: with-gdbm @@ -122,11 +122,11 @@ $nl "All interaction with gdbm database should be realized using special combinator which automates all work for database initialisation and cleanup. All initialisation options are passed to combinator with a database configuration object." { $subsections gdbm with-gdbm } "For actual record manipulation the following words are used:" -{ $subsections gdbm-insert gdbm-exists gdbm-fetch gdbm-delete } +{ $subsections insert exists? fetch delete } { $heading "Sequential access" } "It is possible to iterate through all records in the database with." -{ $subsections gdbm-first-key gdbm-next-key } +{ $subsections first-key next-key } "The order in which records are accessed has nothing to do with the order in which records have been stored. Note that these words can only be used in read-only algorithms since delete operation re-arranges the hash table." ; diff --git a/extra/gdbm/gdbm-tests.factor b/extra/gdbm/gdbm-tests.factor index ab3cb912f6..373ae1c624 100644 --- a/extra/gdbm/gdbm-tests.factor +++ b/extra/gdbm/gdbm-tests.factor @@ -20,30 +20,30 @@ CLEANUP test.db reader >>role [ ] with-gdbm ] [ gdbm-file-open-error = ] must-fail-with -[ f ] [ [ "foo" gdbm-exists ] with-test.db ] unit-test +[ f ] [ [ "foo" exists? ] with-test.db ] unit-test -[ ] [ [ "foo" 41 gdbm-insert ] with-test.db ] unit-test +[ ] [ [ "foo" 41 insert ] with-test.db ] unit-test [ - [ "foo" 42 gdbm-insert ] with-test.db + [ "foo" 42 insert ] with-test.db ] [ gdbm-cannot-replace = ] must-fail-with [ ] [ [ - "foo" 42 gdbm-replace - "bar" 43 gdbm-replace - "baz" 44 gdbm-replace + "foo" 42 replace + "bar" 43 replace + "baz" 44 replace ] with-test.db ] unit-test -[ 42 t ] [ [ "foo" gdbm-fetch* ] with-test.db ] unit-test +[ 42 t ] [ [ "foo" fetch* ] with-test.db ] unit-test -[ f f ] [ [ "unknown" gdbm-fetch* ] with-test.db ] unit-test +[ f f ] [ [ "unknown" fetch* ] with-test.db ] unit-test [ [ - 300 gdbm-set-cache-size 300 gdbm-set-cache-size + 300 set-cache-size 300 set-cache-size ] with-test.db ] [ gdbm-option-already-set = ] must-fail-with @@ -51,8 +51,8 @@ CLEANUP [ V{ } [ - gdbm-first-key - [ gdbm-next-key* ] [ [ swap push ] 2keep ] do while drop + first-key + [ next-key* ] [ [ swap push ] 2keep ] do while drop ] with-test.db V{ "foo" "bar" "baz" } set= @@ -60,7 +60,7 @@ CLEANUP [ f ] [ - test.db newdb >>role [ "foo" gdbm-exists ] with-gdbm + test.db newdb >>role [ "foo" exists? ] with-gdbm ] unit-test diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 7993864643..021fadd514 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -71,42 +71,42 @@ PRIVATE> : gdbm-error-message ( error -- msg ) gdbm_strerror ; -: gdbm-replace ( key content -- ) GDBM_REPLACE gdbm-store ; -: gdbm-insert ( key content -- ) GDBM_INSERT gdbm-store ; +: replace ( key content -- ) GDBM_REPLACE gdbm-store ; +: insert ( key content -- ) GDBM_INSERT gdbm-store ; -: gdbm-delete ( key -- ) +: delete ( key -- ) [ dbf swap object>datum gdbm_delete check-error ] with-destructors ; -: gdbm-fetch* ( key -- content ? ) +: fetch* ( key -- content ? ) [ dbf swap object>datum gdbm_fetch datum>object* ] with-destructors ; -: gdbm-first-key* ( -- key ? ) +: first-key* ( -- key ? ) [ dbf gdbm_firstkey datum>object* ] with-destructors ; -: gdbm-next-key* ( key -- next-key ? ) +: next-key* ( key -- next-key ? ) [ dbf swap object>datum gdbm_nextkey datum>object* ] with-destructors ; -: gdbm-fetch ( key -- content/f ) gdbm-fetch* drop ; -: gdbm-first-key ( -- key/f ) gdbm-first-key* drop ; -: gdbm-next-key ( key -- key/f ) gdbm-next-key* drop ; +: fetch ( key -- content/f ) fetch* drop ; +: first-key ( -- key/f ) first-key* drop ; +: next-key ( key -- key/f ) next-key* drop ; -: gdbm-reorganize ( -- ) dbf gdbm_reorganize check-error ; +: reorganize ( -- ) dbf gdbm_reorganize check-error ; -: gdbm-sync ( -- ) dbf gdbm_sync ; +: synchronize ( -- ) dbf gdbm_sync ; -: gdbm-exists ( key -- ? ) +: exists? ( key -- ? ) [ dbf swap object>datum gdbm_exists c-bool> ] with-destructors ; -: gdbm-set-cache-size ( size -- ) GDBM_CACHESIZE setopt ; -: gdbm-set-sync-mode ( ? -- ) GDBM_SYNCMODE setopt ; -: gdbm-set-block-pool ( ? -- ) GDBM_CENTFREE setopt ; -: gdbm-set-block-merging ( ? -- ) GDBM_COALESCEBLKS setopt ; +: set-cache-size ( size -- ) GDBM_CACHESIZE setopt ; +: set-sync-mode ( ? -- ) GDBM_SYNCMODE setopt ; +: set-block-pool ( ? -- ) GDBM_CENTFREE setopt ; +: set-block-merging ( ? -- ) GDBM_COALESCEBLKS setopt ; -: gdbm-fdesc ( -- desc ) dbf gdbm_fdesc ; +: gdbm-file-descriptor ( -- desc ) dbf gdbm_fdesc ; : with-gdbm ( gdbm quot -- ) [ gdbm-open &gdbm-close current-dbf set ] prepose curry From 0c020a47d843e5c1101dd8234ab074cc3466754c Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Mon, 28 Jun 2010 03:30:52 +0400 Subject: [PATCH 19/21] gdbm: each-key - higher order combinator for sequential access --- extra/gdbm/gdbm-docs.factor | 16 +++++++++++++++- extra/gdbm/gdbm-tests.factor | 10 +++------- extra/gdbm/gdbm.factor | 10 ++++++++++ 3 files changed, 28 insertions(+), 8 deletions(-) diff --git a/extra/gdbm/gdbm-docs.factor b/extra/gdbm/gdbm-docs.factor index e712da3c99..18e5d5cf33 100644 --- a/extra/gdbm/gdbm-docs.factor +++ b/extra/gdbm/gdbm-docs.factor @@ -44,6 +44,18 @@ HELP: exists? { $values { "key" object } { "?" boolean } } { $description "Searches for a particular key without retreiving it." } ; +HELP: each-key +{ $values { "quot" quotation } } +{ $description "Applies the quotation to the each key in the database." } ; + +HELP: each-value +{ $values { "quot" quotation } } +{ $description "Applies the quotation to the each value in the database." } ; + +HELP: each-record +{ $values { "quot" quotation } } +{ $description "Applies the quotation to the each key-value pair in the database." } ; + HELP: gdbm-file-descriptor { $values { "desc" integer } } { $description "Returns the file descriptor of the database. This is used for manual database locking if it was opened with " { $snippet "nolock" } " flag set to " { $link t } "." } ; @@ -125,8 +137,10 @@ $nl { $subsections insert exists? fetch delete } { $heading "Sequential access" } -"It is possible to iterate through all records in the database with." +"It is possible to iterate through all records in the database with" { $subsections first-key next-key } +"The following combinators, however, provide more convenient way to do that:" +{ $subsections each-key each-value each-record } "The order in which records are accessed has nothing to do with the order in which records have been stored. Note that these words can only be used in read-only algorithms since delete operation re-arranges the hash table." ; diff --git a/extra/gdbm/gdbm-tests.factor b/extra/gdbm/gdbm-tests.factor index 373ae1c624..b720dfc0f7 100644 --- a/extra/gdbm/gdbm-tests.factor +++ b/extra/gdbm/gdbm-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2010 Dmitry Shubin. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors continuations gdbm gdbm.ffi io.directories +USING: accessors arrays continuations gdbm gdbm.ffi io.directories io.files.temp kernel sequences sets tools.test ; IN: gdbm.tests @@ -49,12 +49,8 @@ CLEANUP [ t ] [ - V{ } - [ - first-key - [ next-key* ] [ [ swap push ] 2keep ] do while drop - ] with-test.db - V{ "foo" "bar" "baz" } set= + V{ } [ [ 2array append ] each-record ] with-test.db + V{ "foo" "bar" "baz" 42 43 44 } set= ] unit-test diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 021fadd514..6223a6b79e 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -93,6 +93,16 @@ PRIVATE> : first-key ( -- key/f ) first-key* drop ; : next-key ( key -- key/f ) next-key* drop ; +:: each-key ( ... quot: ( ... key -- ... ) -- ... ) + first-key* + [ [ next-key* ] [ quot keep ] do while ] when drop ; inline + +: each-value ( ... quot: ( ... value -- ... ) -- ... ) + [ fetch ] prepose each-key ; inline + +: each-record ( ... quot: ( ... key value -- ... ) -- ... ) + [ dup fetch ] prepose each-key ; inline + : reorganize ( -- ) dbf gdbm_reorganize check-error ; : synchronize ( -- ) dbf gdbm_sync ; From 2446a59744df465374df040705ff6bf633534538 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Mon, 28 Jun 2010 03:50:06 +0400 Subject: [PATCH 20/21] gdbm: move enums to main vocab --- extra/gdbm/ffi/ffi.factor | 29 ++--------------------------- extra/gdbm/gdbm-tests.factor | 2 +- extra/gdbm/gdbm.factor | 35 +++++++++++++++++++++++++++++++---- 3 files changed, 34 insertions(+), 32 deletions(-) diff --git a/extra/gdbm/ffi/ffi.factor b/extra/gdbm/ffi/ffi.factor index 307f749cb4..f2c866769e 100644 --- a/extra/gdbm/ffi/ffi.factor +++ b/extra/gdbm/ffi/ffi.factor @@ -14,8 +14,6 @@ LIBRARY: libgdbm C-GLOBAL: c-string gdbm_version -ENUM: gdbm-role reader writer wrcreat newdb ; - CONSTANT: GDBM_SYNC HEX: 20 CONSTANT: GDBM_NOLOCK HEX: 40 @@ -46,29 +44,6 @@ FUNCTION: int gdbm_exists ( GDBM_FILE dbf, datum key ) ; FUNCTION: int gdbm_setopt ( GDBM_FILE dbf, int option, int* value, int size ) ; FUNCTION: int gdbm_fdesc ( GDBM_FILE dbf ) ; -ENUM: gdbm-error - gdbm-no-error - gdbm-malloc-error - gdbm-block-size-error - gdbm-file-open-error - gdbm-file-write-error - gdbm-file-seek-error - gdbm-file-read-error - gdbm-bad-magic-number - gdbm-empty-database - gdbm-cant-be-reader - gdbm-cant-be-writer - gdbm-reader-cant-delete - gdbm-reader-cant-store - gdbm-reader-cant-reorganize - gdbm-unknown-update - gdbm-item-not-found - gdbm-reorganize-failed - gdbm-cannot-replace - gdbm-illegal-data - gdbm-option-already-set - gdbm-illegal-option ; +C-GLOBAL: int gdbm_errno -C-GLOBAL: gdbm-error gdbm_errno - -FUNCTION: c-string gdbm_strerror ( gdbm-error errno ) ; +FUNCTION: c-string gdbm_strerror ( int errno ) ; diff --git a/extra/gdbm/gdbm-tests.factor b/extra/gdbm/gdbm-tests.factor index b720dfc0f7..9d233c8949 100644 --- a/extra/gdbm/gdbm-tests.factor +++ b/extra/gdbm/gdbm-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2010 Dmitry Shubin. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays continuations gdbm gdbm.ffi io.directories +USING: accessors arrays continuations gdbm io.directories io.files.temp kernel sequences sets tools.test ; IN: gdbm.tests diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 6223a6b79e..54980cb309 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -1,10 +1,13 @@ ! Copyright (C) 2010 Dmitry Shubin. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types alien.data alien.destructors -alien.enums classes.struct combinators destructors gdbm.ffi io.backend -kernel libc locals math namespaces sequences serialize strings ; +alien.enums alien.syntax classes.struct combinators destructors +gdbm.ffi io.backend kernel libc locals math namespaces sequences +serialize strings ; IN: gdbm +ENUM: gdbm-role reader writer wrcreat newdb ; + TUPLE: gdbm { name string } { block-size integer } @@ -15,10 +18,33 @@ TUPLE: gdbm : ( -- gdbm ) gdbm new ; +ENUM: gdbm-error + gdbm-no-error + gdbm-malloc-error + gdbm-block-size-error + gdbm-file-open-error + gdbm-file-write-error + gdbm-file-seek-error + gdbm-file-read-error + gdbm-bad-magic-number + gdbm-empty-database + gdbm-cant-be-reader + gdbm-cant-be-writer + gdbm-reader-cant-delete + gdbm-reader-cant-store + gdbm-reader-cant-reorganize + gdbm-unknown-update + gdbm-item-not-found + gdbm-reorganize-failed + gdbm-cannot-replace + gdbm-illegal-data + gdbm-option-already-set + gdbm-illegal-option ; + enum throw ; : check-error ( ret -- ) 0 = [ gdbm-throw ] unless ; @@ -69,7 +95,8 @@ PRIVATE> : gdbm-info ( -- str ) gdbm_version ; -: gdbm-error-message ( error -- msg ) gdbm_strerror ; +: gdbm-error-message ( error -- msg ) + enum>number gdbm_strerror ; : replace ( key content -- ) GDBM_REPLACE gdbm-store ; : insert ( key content -- ) GDBM_INSERT gdbm-store ; From 18c93fa1bd3817e3c493d7edba1052b3434cf329 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Sun, 4 Jul 2010 02:12:07 +0400 Subject: [PATCH 21/21] gdbm: add shorthands for common cases --- extra/gdbm/gdbm-tests.factor | 4 ++-- extra/gdbm/gdbm.factor | 10 ++++++++++ 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/extra/gdbm/gdbm-tests.factor b/extra/gdbm/gdbm-tests.factor index 9d233c8949..4a102deeb1 100644 --- a/extra/gdbm/gdbm-tests.factor +++ b/extra/gdbm/gdbm-tests.factor @@ -25,7 +25,7 @@ CLEANUP [ ] [ [ "foo" 41 insert ] with-test.db ] unit-test [ - [ "foo" 42 insert ] with-test.db + db-path [ "foo" 42 insert ] with-gdbm-writer ] [ gdbm-cannot-replace = ] must-fail-with [ ] @@ -37,7 +37,7 @@ CLEANUP ] with-test.db ] unit-test -[ 42 t ] [ [ "foo" fetch* ] with-test.db ] unit-test +[ 42 t ] [ db-path [ "foo" fetch* ] with-gdbm-reader ] unit-test [ f f ] [ [ "unknown" fetch* ] with-test.db ] unit-test diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 54980cb309..2fe758f539 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -148,3 +148,13 @@ PRIVATE> : with-gdbm ( gdbm quot -- ) [ gdbm-open &gdbm-close current-dbf set ] prepose curry [ with-scope ] curry with-destructors ; inline + +:: with-gdbm-role ( name role quot -- ) + name >>name role >>role quot with-gdbm ; inline + +: with-gdbm-reader ( name quot -- ) + reader swap with-gdbm-role ; inline + +: with-gdbm-writer ( name quot -- ) + writer swap with-gdbm-role ; inline +