]> gitweb.factorcode.org Git - factor.git/commitdiff
gdbm: switch back to simpler error handling scheme
authorDmitry Shubin <dmitry.sh@gmail.com>
Sat, 26 Jun 2010 18:06:35 +0000 (22:06 +0400)
committerDmitry Shubin <dmitry.sh@gmail.com>
Sat, 26 Jun 2010 18:06:35 +0000 (22:06 +0400)
extra/gdbm/ffi/ffi.factor
extra/gdbm/gdbm.factor

index 142e2ae2f738c08d2dbd63f0995a6ab05a666e86..382315b4fe32a21d65a68b756e8e9c3c9549adbd 100644 (file)
@@ -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 ) ;
index 2f052a3872d578b01600d3aea1c6df8d5cacf55b..bc3ac33d8b94ff1b8a79c0b5922382339feb1527 100644 (file)
@@ -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 ;
-
 
 <PRIVATE
 
-: error-table ( -- table )
-    {
-        {  0 gdbm-no-error               }
-        {  1 gdbm-malloc-error           }
-        {  2 gdbm-block-size-error       }
-        {  3 gdbm-file-open-error        }
-        {  4 gdbm-file-write-error       }
-        {  5 gdbm-file-seek-error        }
-        {  6 gdbm-file-read-error        }
-        {  7 gdbm-bad-magic-number       }
-        {  8 gdbm-empty-database         }
-        {  9 gdbm-cant-be-reader         }
-        { 10 gdbm-cant-be-writer         }
-        { 11 gdbm-reader-cant-delete     }
-        { 12 gdbm-reader-cant-store      }
-        { 13 gdbm-reader-cant-reorganize }
-        { 14 gdbm-unknown-update         }
-        { 15 gdbm-item-not-found         }
-        { 16 gdbm-reorganize-failed      }
-        { 17 gdbm-cannot-replace         }
-        { 18 gdbm-illegal-data           }
-        { 19 gdbm-option-already-set     }
-        { 20 gdbm-illegal-option         }
-    } >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 ;
 
-<PRIVATE
-
-:: (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-setopt ( option value -- )
     over GDBM_CACHESIZE = [ >c-bool ] unless (gdbm-setopt) ;