gdbm: add higher level interface
parent
1ed16f775c
commit
4378948e47
|
@ -0,0 +1 @@
|
||||||
|
Dmitry Shubin
|
|
@ -38,7 +38,7 @@ TYPEDEF: _GDBM_FILE* GDBM_FILE
|
||||||
|
|
||||||
CALLBACK: void fatal_func_cb ;
|
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: 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: int gdbm_store ( GDBM_FILE dbf, datum key, datum content, int flag ) ;
|
||||||
FUNCTION: datum gdbm_fetch ( GDBM_FILE dbf, datum key ) ;
|
FUNCTION: datum gdbm_fetch ( GDBM_FILE dbf, datum key ) ;
|
||||||
FUNCTION: int gdbm_delete ( 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
|
TYPEDEF: int gdbm_error
|
||||||
C-GLOBAL: gdbm_error gdbm_errno
|
C-GLOBAL: gdbm_error gdbm_errno
|
||||||
|
|
||||||
|
FUNCTION: c-string gdbm_strerror ( gdbm_error errno ) ;
|
||||||
|
|
|
@ -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 <struct-boa> ;
|
||||||
|
|
||||||
|
: 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
|
Loading…
Reference in New Issue