refactor a bit of sqlite

fix inheritance test in tuple-db

diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor
index f2e603b0499cc9ade20dc3bc17b945533aee77c3..b652e8fed708b3d929fe7691c490d61620c36481 100755 (executable)
--- a/extra/db/sqlite/lib/lib.factor
+++ b/extra/db/sqlite/lib/lib.factor
@@ -159,12 +159,11 @@ ERROR: sqlite-sql-error < sql-error n string ;
     dup sqlite-#columns [ sqlite-column ] with map ;
 
 : sqlite-step-has-more-rows? ( prepared -- bool )
-    dup SQLITE_ROW =  [
-        drop t
-    ] [
-        dup SQLITE_DONE =
-        [ drop ] [ sqlite-check-result ] if f
-    ] if ;
+    {
+        { SQLITE_ROW [ t ] }
+        { SQLITE_DONE [ f ] }
+        [ sqlite-check-result f ]
+    } case ;
 
 : sqlite-next ( prepared -- ? )
     sqlite3_step sqlite-step-has-more-rows? ;

diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index c10775f1c94bdce036485add02697542d76a1620..cc4e4d116ad03dbcd2831725c0f414ac19c9e4e6 100755 (executable)
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -16,7 +16,7 @@ M: sqlite-db make-db* ( path db -- db )
     swap >>path ;
 
 M: sqlite-db db-open ( db -- db )
-    [ path>> sqlite-open ] [ swap >>handle ] bi ;
+    dup path>> sqlite-open >>handle ;
 
 M: sqlite-db db-close ( handle -- ) sqlite-close ;
 M: sqlite-db dispose ( db -- ) dispose-db ;
@@ -197,4 +197,3 @@ M: sqlite-db compound ( str seq -- str' )
         { "default" [ first number>string join-space ] }
         [ 2drop ] 
     } case ;
-

diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor
index d560acc1d10d558a60f66ce94979d1c3b92e99d6..2838a8433a6f0994ef5aea13f6f61c1cb5e06b42 100755 (executable)
--- a/extra/db/tuples/tuples.factor
+++ b/extra/db/tuples/tuples.factor
@@ -76,16 +76,16 @@ M: retryable execute-statement* ( statement type -- )
         [ regenerate-params bind-statement* f ] cleanup
     ] curry 10 retry drop ;
 
-: resulting-tuple ( row out-params -- tuple )
-    dup peek class>> new [
+: resulting-tuple ( class row out-params -- tuple )
+    rot class new [
         [
             >r slot-name>> r> set-slot-named
         ] curry 2each
     ] keep ;
 
-: query-tuples ( statement -- seq )
+: query-tuples ( exemplar-tuple statement -- seq )
     [ out-params>> ] keep query-results [
-        [ sql-row-typed swap resulting-tuple ] with query-map
+        [ sql-row-typed swap resulting-tuple ] with with query-map
     ] with-disposal ;
  
 : query-modify-tuple ( tuple statement -- )
@@ -145,7 +145,7 @@ M: retryable execute-statement* ( statement type -- )
 
 : select-tuples ( tuple -- tuples )
     dup dup class <select-by-slots-statement> [
-        [ bind-tuple ] keep query-tuples
+        [ bind-tuple ] [  query-tuples ] 2bi
     ] with-disposal ;
 
 : select-tuple ( tuple -- tuple/f ) select-tuples ?first ;