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

diff --git a/basis/db/db-tests.factor b/basis/db/db-tests.factor
index 0d95e3aea7dd20bad168251c80c2253c7b00ebf5..3f1dab2c377dbd801ee861c5e98ada9725078620 100755 (executable)
--- a/basis/db/db-tests.factor
+++ b/basis/db/db-tests.factor
@@ -1,5 +1,5 @@
-IN: db.tests\r
 USING: tools.test db kernel ;\r
+IN: db.tests\r
 \r
 { 1 0 } [ [ drop ] query-each ] must-infer-as\r
 { 1 1 } [ [ ] query-map ] must-infer-as\r

diff --git a/basis/db/db.factor b/basis/db/db.factor
index c52d1db148609124e6bcd0e7332dedc3a75dea95..c269341240351f97bac9ee8f80998c9bf650abdc 100755 (executable)
--- a/basis/db/db.factor
+++ b/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 )
-    new-db make-db* ;
+: make-db ( seq class -- 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
-        dup delete-statements>> dispose-statements
-        handle>> db-close
+        {
+            [ insert-statements>> dispose-statements ]
+            [ update-statements>> dispose-statements ]
+            [ 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: <prepared-statement> db ( str in out -- statement )
+HOOK: <simple-statement> db ( string in out -- statement )
+HOOK: <prepared-statement> db ( string in out -- statement )
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( statement -- )
 GENERIC: low-level-bind ( statement -- )

diff --git a/basis/db/errors/errors.factor b/basis/db/errors/errors.factor
index 1e0d1e7fb415fecf7962a4707d7ab3c2b8f88a89..da6301639f143a3253993cf7e1c15c1190f8adf9 100644 (file)
--- a/basis/db/errors/errors.factor
+++ b/basis/db/errors/errors.factor
@@ -6,6 +6,5 @@ IN: db.errors
 ERROR: db-error ;
 ERROR: sql-error ;
 
-
 ERROR: table-exists ;
 ERROR: bad-schema ;

diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor
index e57efbc360b38c42034b1e871e5beeb409d99113..692241fab09097747a20412c95c5b78e0bda8a0d 100755 (executable)
--- a/basis/db/postgresql/postgresql.factor
+++ b/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

diff --git a/basis/db/sqlite/ffi/ffi.factor b/basis/db/sqlite/ffi/ffi.factor
index b443f53e78adf08b15183183280e87702de89575..8de0226e52f4b377c2c4a0c2e5cf3b70935bca35 100755 (executable)
--- a/basis/db/sqlite/ffi/ffi.factor
+++ b/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 ) ;

diff --git a/basis/db/sqlite/sqlite-tests.factor b/basis/db/sqlite/sqlite-tests.factor
index b30cb4ba80f3d7bb1fb528db68cfa669f74706f9..67eac2702b618e0eb7f9204ac919bf30a21477a6 100755 (executable)
--- a/basis/db/sqlite/sqlite-tests.factor
+++ b/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')"

diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor
index 231b60e083aa88b87844687ffa87b2189c99c201..49d79b1b8c1dc1e1081f58462bd4dad9aea58e78 100755 (executable)
--- a/basis/db/sqlite/sqlite.factor
+++ b/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 ;
 

diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor
index c3480093c5345d0d68494780cfa58385621240b7..2efa41c4019e513728c82ccf9523dfe9e29d08b9 100755 (executable)
--- a/basis/db/types/types.factor
+++ b/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>> ;