fix stack effects, remove two redundant sqlite ffi words, minor cleanups

basis/db/db-tests.factor

@@ -1,5 +1,5 @@
-IN: db.tests
 USING: tools.test db kernel ;
+IN: db.tests
 
 { 1 0 } [ [ drop ] query-each ] must-infer-as
 { 1 1 } [ [ ] query-map ] must-infer-as

basis/db/db.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes continuations destructors kernel math
 namespaces sequences sequences.lib classes.tuple words strings
-tools.walker accessors combinators.lib ;
+tools.walker accessors combinators.lib combinators ;
 IN: db
 
 TUPLE: db
@@ -15,24 +15,25 @@ TUPLE: db
     new
         H{ } clone >>insert-statements
         H{ } clone >>update-statements
-        H{ } clone >>delete-statements ;
+        H{ } clone >>delete-statements ; inline
 
-GENERIC: make-db* ( seq class -- db )
+GENERIC: make-db* ( seq db -- db )
 
-: make-db ( seq class -- db )
+: make-db ( seq class -- db ) new-db make-db* ;
-    new-db make-db* ;
 
 GENERIC: db-open ( db -- db )
 HOOK: db-close db ( handle -- )
 
 : dispose-statements ( assoc -- ) values dispose-each ;
 
-: dispose-db ( db -- ) 
+: db-dispose ( db -- ) 
     dup db [
-        dup insert-statements>> dispose-statements
+        {
-        dup update-statements>> dispose-statements
+            [ insert-statements>> dispose-statements ]
-        dup delete-statements>> dispose-statements
+            [ update-statements>> dispose-statements ]
-        handle>> db-close
+            [ delete-statements>> dispose-statements ]
+            [ handle>> db-close ]
+        } cleave
     ] with-variable ;
 
 TUPLE: statement handle sql in-params out-params bind-params bound? type retries ;
@@ -47,8 +48,8 @@ TUPLE: result-set sql in-params out-params handle n max ;
         swap >>in-params
         swap >>sql ;
 
-HOOK: <simple-statement> db ( str in out -- statement )
+HOOK: <simple-statement> db ( string in out -- statement )
-HOOK: <prepared-statement> db ( str in out -- statement )
+HOOK: <prepared-statement> db ( string in out -- statement )
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( statement -- )
 GENERIC: low-level-bind ( statement -- )

basis/db/errors/errors.factor

@@ -6,6 +6,5 @@ IN: db.errors
 ERROR: db-error ;
 ERROR: sql-error ;
 
-
 ERROR: table-exists ;
 ERROR: bad-schema ;

basis/db/postgresql/postgresql.factor

@@ -16,7 +16,7 @@ TUPLE: postgresql-statement < statement ;
 
 TUPLE: postgresql-result-set < result-set ;
 
-M: postgresql-db make-db* ( seq tuple -- db )
+M: postgresql-db make-db* ( seq db -- db )
     >r first4 r>
         swap >>db
         swap >>pass

basis/db/sqlite/ffi/ffi.factor

@@ -118,9 +118,6 @@ FUNCTION: int sqlite3_bind_blob ( sqlite3_stmt* pStmt, int index, void* ptr, int
 FUNCTION: int sqlite3_bind_double ( sqlite3_stmt* pStmt, int index, double x ) ;
 FUNCTION: int sqlite3_bind_int ( sqlite3_stmt* pStmt, int index, int n ) ;
 FUNCTION: int sqlite3_bind_int64 ( sqlite3_stmt* pStmt, int index, sqlite3_int64 n ) ;
-: sqlite3-bind-uint64 ( pStmt index in64 -- int )
-    "int" "sqlite" "sqlite3_bind_int64"
-    { "sqlite3_stmt*" "int" "sqlite3_uint64" } alien-invoke ;
 FUNCTION: int sqlite3_bind_null ( sqlite3_stmt* pStmt, int n ) ;
 FUNCTION: int sqlite3_bind_text ( sqlite3_stmt* pStmt, int index, char* text, int len, int destructor ) ;
 FUNCTION: int sqlite3_bind_parameter_index ( sqlite3_stmt* pStmt, char* name ) ;
@@ -131,9 +128,6 @@ FUNCTION: int sqlite3_column_bytes ( sqlite3_stmt* pStmt, int col ) ;
 FUNCTION: char* sqlite3_column_decltype ( sqlite3_stmt* pStmt, int col ) ;
 FUNCTION: int sqlite3_column_int ( sqlite3_stmt* pStmt, int col ) ;
 FUNCTION: sqlite3_int64 sqlite3_column_int64 ( sqlite3_stmt* pStmt, int col ) ;
-: sqlite3-column-uint64 ( pStmt col -- uint64 )
-    "sqlite3_uint64" "sqlite" "sqlite3_column_int64"
-    { "sqlite3_stmt*" "int" } alien-invoke ;
 FUNCTION: double sqlite3_column_double ( sqlite3_stmt* pStmt, int col ) ;
 FUNCTION: char* sqlite3_column_name ( sqlite3_stmt* pStmt, int col ) ;
 FUNCTION: char* sqlite3_column_text ( sqlite3_stmt* pStmt, int col ) ;

basis/db/sqlite/sqlite-tests.factor

@@ -57,8 +57,7 @@ IN: db.sqlite.tests
     ] with-db
 ] unit-test
 
-[
+[ ] [
-] [
     test.db [
         [
             "insert into person(name, country) values('Jose', 'Mexico')"

basis/db/sqlite/sqlite.factor

@@ -19,7 +19,7 @@ M: sqlite-db db-open ( db -- db )
     dup path>> sqlite-open >>handle ;
 
 M: sqlite-db db-close ( handle -- ) sqlite-close ;
-M: sqlite-db dispose ( db -- ) dispose-db ;
+M: sqlite-db dispose ( db -- ) db-dispose ;
 
 TUPLE: sqlite-statement < statement ;
 

basis/db/types/types.factor

@@ -8,7 +8,7 @@ classes.singleton accessors quotations random ;
 IN: db.types
 
 HOOK: persistent-table db ( -- hash )
-HOOK: compound db ( str obj -- hash )
+HOOK: compound db ( string obj -- hash )
 
 TUPLE: sql-spec class slot-name column-name type primary-key modifiers ;
 
@@ -78,7 +78,7 @@ FACTOR-BLOB NULL URL ;
         swap >>class
     dup normalize-spec ;
 
-: number>string* ( n/str -- str )
+: number>string* ( n/string -- string )
     dup number? [ number>string ] when ;
 
 : remove-db-assigned-id ( specs -- obj )
@@ -97,7 +97,7 @@ FACTOR-BLOB NULL URL ;
 
 ERROR: unknown-modifier ;
 
-: lookup-modifier ( obj -- str )
+: lookup-modifier ( obj -- string )
     {
         { [ dup array? ] [ unclip lookup-modifier swap compound ] }
         [ persistent-table at* [ unknown-modifier ] unless third ]
@@ -105,43 +105,43 @@ ERROR: unknown-modifier ;
 
 ERROR: no-sql-type ;
 
-: (lookup-type) ( obj -- str )
+: (lookup-type) ( obj -- string )
     persistent-table at* [ no-sql-type ] unless ;
 
-: lookup-type ( obj -- str )
+: lookup-type ( obj -- string )
     dup array? [
         unclip (lookup-type) first nip
     ] [
         (lookup-type) first
     ] if ;
 
-: lookup-create-type ( obj -- str )
+: lookup-create-type ( obj -- string )
     dup array? [
         unclip (lookup-type) second swap compound
     ] [
         (lookup-type) second
     ] if ;
 
-: single-quote ( str -- newstr )
+: single-quote ( string -- new-string )
     "'" swap "'" 3append ;
 
-: double-quote ( str -- newstr )
+: double-quote ( string -- new-string )
     "\"" swap "\"" 3append ;
 
-: paren ( str -- newstr )
+: paren ( string -- new-string )
     "(" swap ")" 3append ;
 
-: join-space ( str1 str2 -- newstr )
+: join-space ( string1 string2 -- new-string )
     " " swap 3append ;
 
-: modifiers ( spec -- str )
+: modifiers ( spec -- string )
     modifiers>> [ lookup-modifier ] map " " join
     dup empty? [ " " prepend ] unless ;
 
 HOOK: bind% db ( spec -- )
 HOOK: bind# db ( spec obj -- )
 
-: offset-of-slot ( str obj -- n )
+: offset-of-slot ( string obj -- n )
     class superclasses [ "slots" word-prop ] map concat
     slot-named offset>> ;