]> gitweb.factorcode.org Git - factor.git/commitdiff
gdbm: more refactor.
authorJohn Benediktsson <mrjbq7@gmail.com>
Sat, 25 Dec 2021 22:41:38 +0000 (14:41 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sat, 25 Dec 2021 22:41:38 +0000 (14:41 -0800)
extra/gdbm/gdbm-docs.factor
extra/gdbm/gdbm-tests.factor
extra/gdbm/gdbm.factor

index 55726c72422867ef371be503fa83f472a4c37faa..9331e48a9a6f7fa8aeccbf6c04492dd6f2638caf 100644 (file)
@@ -31,7 +31,7 @@ HELP: gdbm-info
 { $values { "str" string } }
 { $description "Returns version number and build date." } ;
 
-HELP: delete
+HELP: gdbm-delete
 { $values { "key" object } }
 { $description "Removes the keyed item from the database." } ;
 
@@ -43,15 +43,15 @@ HELP: gdbm-exists?
 { $values { "key" object } { "?" boolean } }
 { $description "Searches for a particular key without retreiving it." } ;
 
-HELP: each-key
+HELP: each-gdbm-key
 { $values { "quot" quotation } }
 { $description "Applies the quotation to the each key in the database." } ;
 
-HELP: each-value
+HELP: each-gdbm-value
 { $values { "quot" quotation } }
 { $description "Applies the quotation to the each value in the database." } ;
 
-HELP: each-record
+HELP: each-gdbm-record
 { $values { "quot" quotation } }
 { $description "Applies the quotation to the each key-value pair in the database." } ;
 
@@ -59,61 +59,61 @@ 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: fetch
+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: fetch*
+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: first-key
+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: first-key*
+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: insert
+HELP: gdbm-insert
 { $values { "key" object } { "content" object } }
 { $description "Inserts record into the database. Throws an error if the key already exists." } ;
 
-HELP: next-key
+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: next-key*
+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: reorganize
+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: replace
+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: set-block-merging
+HELP: set-gdbm-block-merging
 { $values { "?" boolean } }
 { $description "If set, this option causes adjacent free blocks to be merged. The default is " { $link f } "." } ;
 
-HELP: set-block-pool
+HELP: set-gdbm-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: set-cache-size
+HELP: set-gdbm-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: set-sync-mode
+HELP: set-gdbm-sync-mode
 { $values { "?" boolean } }
 { $description "Turns on or off file system synchronization. The default is " { $link f } "." } ;
 
-HELP: synchronize
+HELP: gdbm-synchronize
 { $description "Performs database synchronization: make sure the disk version of the database has been completely updated." } ;
 
 HELP: with-gdbm
@@ -133,13 +133,13 @@ $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 <gdbm> with-gdbm }
 "For actual record manipulation the following words are used:"
-{ $subsections insert gdbm-exists? fetch delete }
+{ $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 first-key next-key }
+{ $subsections gdbm-first-key gdbm-next-key }
 "The following combinators, however, provide more convenient way to do that:"
-{ $subsections each-key each-value each-record }
+{ $subsections each-gdbm-key each-gdbm-value each-gdbm-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."
 ;
 
index 1f6fea7508bc2ff45a7d92d791bde5606eb64133..75c14ea69af8470f1f22026d0076f92dedfd9d71 100644 (file)
@@ -18,46 +18,46 @@ CLEANUP
     test.db reader >>role [ ] with-gdbm
 ] [ gdbm-file-open-error = ] must-fail-with
 
-{ f } [ [ "foo" file-exists? ] with-test.db ] unit-test
+{ f } [ [ "foo" gdbm-exists? ] with-test.db ] unit-test
 
-{ } [ [ "foo" 41 insert ] with-test.db ] unit-test
+{ } [ [ "foo" 41 gdbm-insert ] with-test.db ] unit-test
 
 [
-    db-path [ "foo" 42 insert ] with-gdbm-writer
+    db-path [ "foo" 42 gdbm-insert ] with-gdbm-writer
 ] [ gdbm-cannot-replace = ] must-fail-with
 
 { }
 [
     [
-        "foo" 42 replace
-        "bar" 43 replace
-        "baz" 44 replace
+        "foo" 42 gdbm-replace
+        "bar" 43 gdbm-replace
+        "baz" 44 gdbm-replace
     ] with-test.db
 ] unit-test
 
-{ 42 t } [ db-path [ "foo" fetch* ] with-gdbm-reader ] unit-test
+{ 42 t } [ db-path [ "foo" gdbm-fetch* ] with-gdbm-reader ] unit-test
 
-{ f f } [ [ "unknown" fetch* ] with-test.db ] unit-test
+{ f f } [ [ "unknown" gdbm-fetch* ] with-test.db ] unit-test
 
 ! XXX: different behavior on macOS Big Sur and Monterey?
 os macosx? [
     [
         [
-            300 set-cache-size 300 set-cache-size
+            300 set-gdbm-cache-size 300 set-gdbm-cache-size
         ] with-test.db
     ] [ gdbm-option-already-set = ] must-fail-with
 ] unless
 
 { t }
 [
-    V{ } [ [ 2array append ] each-record ] with-test.db
+    V{ } [ [ 2array append ] each-gdbm-record ] with-test.db
     V{ "foo" "bar" "baz" 42 43 44 } set=
 
 ] unit-test
 
 { f }
 [
-    test.db newdb >>role [ "foo" file-exists? ] with-gdbm
+    test.db newdb >>role [ "foo" gdbm-exists? ] with-gdbm
 ] unit-test
 
 CLEANUP
index fb31afd46202ad83b658174163773113f4243edc..7a09649bd8b3258f400c72a46c6cf24c3ca91268 100644 (file)
@@ -83,15 +83,15 @@ DESTRUCTOR: gdbm-close
         gdbm_store check-error
     ] with-destructors ;
 
-:: (setopt) ( value option -- )
+:: (gdbm-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) ;
+: gdbm-setopt ( value option -- )
+    [ GDBM_CACHESIZE = [ >c-bool ] unless ] keep (gdbm-setopt) ;
 
 PRIVATE>
 
@@ -101,50 +101,51 @@ PRIVATE>
 : gdbm-error-message ( error -- msg )
     enum>number gdbm_strerror ;
 
-: replace ( key content -- ) GDBM_REPLACE gdbm-store ;
-: insert ( key content -- ) GDBM_INSERT gdbm-store ;
+: gdbm-replace ( key content -- ) GDBM_REPLACE gdbm-store ;
 
-: delete ( key -- )
+: gdbm-insert ( key content -- ) GDBM_INSERT gdbm-store ;
+
+: gdbm-delete ( key -- )
     [ dbf swap object>datum gdbm_delete check-error ]
     with-destructors ;
 
-: fetch* ( key -- content ? )
+: gdbm-fetch* ( key -- content ? )
     [ dbf swap object>datum gdbm_fetch datum>object* ]
     with-destructors ;
 
-: first-key* ( -- key ? )
+: gdbm-first-key* ( -- key ? )
     [ dbf gdbm_firstkey datum>object* ] with-destructors ;
 
-: next-key* ( key -- next-key ? )
+: gdbm-next-key* ( key -- next-key ? )
     [ dbf swap object>datum gdbm_nextkey datum>object* ]
     with-destructors ;
 
-: fetch ( key -- content/f ) fetch* drop ;
-: first-key ( -- key/f ) first-key* drop ;
-: next-key ( key -- key/f ) next-key* 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 ;
 
-:: each-key ( ... quot: ( ... key -- ... ) -- ... )
-    first-key*
-    [ [ next-key* ] [ quot keep ] do while ] when drop ; inline
+:: each-gdbm-key ( ... quot: ( ... key -- ... ) -- ... )
+    gdbm-first-key*
+    [ [ gdbm-next-key* ] [ quot keep ] do while ] when drop ; inline
 
-: each-value ( ... quot: ( ... value -- ... ) -- ... )
-    [ fetch ] prepose each-key ; inline
+: each-gdbm-value ( ... quot: ( ... value -- ... ) -- ... )
+    [ gdbm-fetch ] prepose each-gdbm-key ; inline
 
-: each-record ( ... quot: ( ... key value -- ... ) -- ... )
-    [ dup fetch ] prepose each-key ; inline
+: each-gdbm-record ( ... quot: ( ... key value -- ... ) -- ... )
+    [ dup gdbm-fetch ] prepose each-gdbm-key ; inline
 
-: reorganize ( -- ) dbf gdbm_reorganize check-error ;
+: gdbm-reorganize ( -- ) dbf gdbm_reorganize check-error ;
 
-: synchronize ( -- ) dbf gdbm_sync ;
+: gdbm-synchronize ( -- ) dbf gdbm_sync ;
 
 : gdbm-exists? ( key -- ? )
     [ dbf swap object>datum gdbm_exists c-bool> ]
     with-destructors ;
 
-: 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 ;
+: set-gdbm-cache-size ( size -- ) GDBM_CACHESIZE gdbm-setopt ;
+: set-gdbm-sync-mode ( ? -- ) GDBM_SYNCMODE gdbm-setopt ;
+: set-gdbm-block-pool ( ? -- ) GDBM_CENTFREE gdbm-setopt ;
+: set-gdbm-block-merging ( ? -- ) GDBM_COALESCEBLKS gdbm-setopt ;
 
 : gdbm-file-descriptor ( -- desc ) dbf gdbm_fdesc ;