Merge branch 'master' of git://factorcode.org/git/factor

Conflicts:
	basis/db/types/types.factor

diff --git a/basis/checksums/common/common.factor b/basis/checksums/common/common.factor
index 7d5f34777d74acc1f3de92d279272cda19e6ee94..0ae4328446c1d1e4aa8295c7165f70845277f75b 100644 (file)
--- a/basis/checksums/common/common.factor
+++ b/basis/checksums/common/common.factor
@@ -1,21 +1,20 @@
 ! Copyright (C) 2006, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.bitwise strings io.binary namespaces
-make grouping ;
+make grouping byte-arrays ;
 IN: checksums.common
 
 SYMBOL: bytes-read
 
-: calculate-pad-length ( length -- pad-length )
-    dup 56 < 55 119 ? swap - ;
+: calculate-pad-length ( length -- length' )
+    [ 56 < 55 119 ? ] keep - ;
 
 : pad-last-block ( str big-endian? length -- str )
     [
-        rot %
-        HEX: 80 ,
-        dup HEX: 3f bitand calculate-pad-length 0 <string> %
-        3 shift 8 rot [ >be ] [ >le ] if %
-    ] "" make 64 group ;
+        [ % ] 2dip HEX: 80 ,
+        [ HEX: 3f bitand calculate-pad-length <byte-array> % ]
+        [ 3 shift 8 rot [ >be ] [ >le ] if % ] bi
+    ] B{ } make 64 group ;
 
 : update-old-new ( old new -- )
     [ [ get ] bi@ w+ dup ] 2keep [ set ] bi@ ; inline

diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor
index 8173ff6a5b137ac24122a582d4ad61cf3e815b99..ae7451cb484dc2f26c7060509dd52b454cce4d7d 100644 (file)
--- a/basis/db/db-docs.factor
+++ b/basis/db/db-docs.factor
@@ -1,20 +1,20 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes kernel help.markup help.syntax sequences
-alien assocs strings math multiline quotations ;
+alien assocs strings math multiline quotations db.private ;
 IN: db
 
-HELP: db
-{ $description "The " { $snippet "db" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries." } ;
+HELP: db-connection
+{ $description "The " { $snippet "db-connection" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries. Stores the current database object as a dynamic variable." } ;
 
-HELP: new-db
-{ $values { "class" class } { "obj" object } }
+HELP: new-db-connection
+{ $values { "class" class } { "obj" db-connection } }
 { $description "Creates a new database object from a given class with caches for prepared statements. Does not actually connect to the database until " { $link db-open } " or " { $link with-db } " is called." }
 { $notes "User-defined databases must call this constructor word instead of " { $link new } "." } ;
 
 HELP: db-open
-{ $values { "db" db } { "db" db } }
-{ $description "Opens a database using the configuration data stored in a " { $link db } " tuple. The database object now references a database handle that must be cleaned up. Therefore, it is better to use the " { $link with-db } " combinator than calling this word directly." } ;
+{ $values { "db" "a database configuration object" } { "db-connection" db-connection } }
+{ $description "Opens a database using the configuration data stored in a " { $snippet "database configuration object" } "tuple. The database object now references a database handle that must be cleaned up. Therefore, it is better to use the " { $link with-db } " combinator than calling this word directly." } ;
 
 HELP: db-close
 { $values { "handle" alien } }
@@ -141,13 +141,13 @@ HELP: rollback-transaction
 HELP: sql-command
 { $values
      { "sql" string } }
-{ $description "Executes a SQL string using the databse in the " { $link db } " symbol." } ;
+{ $description "Executes a SQL string using the databse in the " { $link db-connection } " symbol." } ;
 
 HELP: sql-query
 { $values
      { "sql" string }
      { "rows" "an array of arrays of strings" } }
-{ $description "Runs a SQL query of raw text in the database in the " { $link db } " symbol. Each row is returned as an array of strings; no type-conversions are done on the resulting data." } ;
+{ $description "Runs a SQL query of raw text in the database in the " { $link db-connection } " symbol. Each row is returned as an array of strings; no type-conversions are done on the resulting data." } ;
 
 { sql-command sql-query } related-words
 
@@ -167,8 +167,8 @@ HELP: sql-row-typed
 
 HELP: with-db
 { $values
-     { "db" db } { "quot" quotation } }
-{ $description "Calls the quotation with a database bound to the " { $link db } " symbol. See " { $link "db-custom-database-combinators" } " for help setting up database access." } ;
+     { "db" "a database configuration object" } { "quot" quotation } }
+{ $description "Calls the quotation with a database bound to the " { $link db-connection } " symbol. See " { $link "db-custom-database-combinators" } " for help setting up database access." } ;
 
 HELP: with-transaction
 { $values

diff --git a/basis/db/db.factor b/basis/db/db.factor
index b7bd8218a2e0d832e9083ec95d75a78ed4cd2e98..0b18044f2b8002a57eccba0b257c47f5c2cab671 100644 (file)
--- a/basis/db/db.factor
+++ b/basis/db/db.factor
@@ -5,25 +5,29 @@ namespaces sequences classes.tuple words strings
 tools.walker accessors combinators fry ;
 IN: db
 
-TUPLE: db
+<PRIVATE
+
+TUPLE: db-connection
     handle
     insert-statements
     update-statements
     delete-statements ;
 
-: new-db ( class -- obj )
+: new-db-connection ( class -- obj )
     new
         H{ } clone >>insert-statements
         H{ } clone >>update-statements
         H{ } clone >>delete-statements ; inline
 
-GENERIC: db-open ( db -- db )
-HOOK: db-close db ( handle -- )
+PRIVATE>
+
+GENERIC: db-open ( db -- db-connection )
+HOOK: db-close db-connection ( handle -- )
 
 : dispose-statements ( assoc -- ) values dispose-each ;
 
-M: db dispose ( db -- ) 
-    dup db [
+M: db-connection dispose ( db-connection -- ) 
+    dup db-connection [
         [ dispose-statements H{ } clone ] change-insert-statements
         [ dispose-statements H{ } clone ] change-update-statements
         [ dispose-statements H{ } clone ] change-delete-statements
@@ -63,8 +67,8 @@ TUPLE: prepared-statement < statement ;
         swap >>in-params
         swap >>sql ;
 
-HOOK: <simple-statement> db ( string in out -- statement )
-HOOK: <prepared-statement> db ( string in out -- statement )
+HOOK: <simple-statement> db-connection ( string in out -- statement )
+HOOK: <prepared-statement> db-connection ( string in out -- statement )
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( statement -- )
 GENERIC: low-level-bind ( statement -- )
@@ -107,8 +111,8 @@ M: object execute-statement* ( statement type -- )
     accumulator [ query-each ] dip { } like ; inline
 
 : with-db ( db quot -- )
-    [ db-open db ] dip
-    '[ db get [ drop @ ] with-disposal ] with-variable ; inline
+    [ db-open db-connection ] dip
+    '[ db-connection get [ drop @ ] with-disposal ] with-variable ; inline
 
 ! Words for working with raw SQL statements
 : default-query ( query -- result-set )
@@ -126,13 +130,13 @@ M: object execute-statement* ( statement type -- )
 ! Transactions
 SYMBOL: in-transaction
 
-HOOK: begin-transaction db ( -- )
-HOOK: commit-transaction db ( -- )
-HOOK: rollback-transaction db ( -- )
+HOOK: begin-transaction db-connection ( -- )
+HOOK: commit-transaction db-connection ( -- )
+HOOK: rollback-transaction db-connection ( -- )
 
-M: db begin-transaction ( -- ) "BEGIN" sql-command ;
-M: db commit-transaction ( -- ) "COMMIT" sql-command ;
-M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
+M: db-connection begin-transaction ( -- ) "BEGIN" sql-command ;
+M: db-connection commit-transaction ( -- ) "COMMIT" sql-command ;
+M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ;
 
 : in-transaction? ( -- ? ) in-transaction get ;
 

diff --git a/basis/db/pools/pools.factor b/basis/db/pools/pools.factor
index 8bc5e87f0ea4ef26f17fed72410746c70e9c4306..55ff3a383b58a22c1007cb375706126524b6d975 100644 (file)
--- a/basis/db/pools/pools.factor
+++ b/basis/db/pools/pools.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel arrays namespaces sequences continuations
-io.pools db fry ;
+io.pools db fry db.private ;
 IN: db.pools
 
 TUPLE: db-pool < pool db ;
@@ -17,4 +17,4 @@ M: db-pool make-connection ( pool -- )
     db>> db-open ;
 
 : with-pooled-db ( pool quot -- )
-    '[ db _ with-variable ] with-pooled-connection ; inline
+    '[ db-connection _ with-variable ] with-pooled-connection ; inline

diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor
index 5149d14f3d8986d5a77c1b015b970cc010244e45..19cf5c5002f91161f0df6afb2c681d0d75ee3259 100644 (file)
--- a/basis/db/postgresql/lib/lib.factor
+++ b/basis/db/postgresql/lib/lib.factor
@@ -6,7 +6,7 @@ db.types tools.walker ascii splitting math.parser combinators
 libc shuffle calendar.format byte-arrays destructors prettyprint
 accessors strings serialize io.encodings.binary io.encodings.utf8
 alien.strings io.streams.byte-array summary present urls
-specialized-arrays.uint specialized-arrays.alien ;
+specialized-arrays.uint specialized-arrays.alien db.private ;
 IN: db.postgresql.lib
 
 : postgresql-result-error-message ( res -- str/f )
@@ -24,7 +24,7 @@ IN: db.postgresql.lib
     "\n" split [ [ blank? ] trim ] map "\n" join ;
 
 : postgresql-error-message ( -- str )
-    db get handle>> (postgresql-error-message) ;
+    db-connection get handle>> (postgresql-error-message) ;
 
 : postgresql-error ( res -- res )
     dup [ postgresql-error-message throw ] unless ;
@@ -44,7 +44,7 @@ M: postgresql-result-null summary ( obj -- str )
     dup PQstatus zero? [ (postgresql-error-message) throw ] unless ;
 
 : do-postgresql-statement ( statement -- res )
-    db get handle>> swap sql>> PQexec dup postgresql-result-ok? [
+    db-connection get handle>> swap sql>> PQexec dup postgresql-result-ok? [
         [ postgresql-result-error-message ] [ PQclear ] bi throw
     ] unless ;
 
@@ -99,7 +99,7 @@ M: postgresql-result-null summary ( obj -- str )
 
 : do-postgresql-bound-statement ( statement -- res )
     [
-        [ db get handle>> ] dip
+        [ db-connection get handle>> ] dip
         {
             [ sql>> ]
             [ bind-params>> length ]

diff --git a/basis/db/postgresql/postgresql-tests.factor b/basis/db/postgresql/postgresql-tests.factor
index bc5ec2f0c5d10633319240f7eb86cec6dc0e5cac..cf6dc903f10081b3109577c2e13f6904c3df8e5d 100644 (file)
--- a/basis/db/postgresql/postgresql-tests.factor
+++ b/basis/db/postgresql/postgresql-tests.factor
@@ -1,5 +1,5 @@
 USING: kernel db.postgresql alien continuations io classes
-prettyprint sequences namespaces tools.test db
+prettyprint sequences namespaces tools.test db db.private
 db.tuples db.types unicode.case accessors system ;
 IN: db.postgresql.tests
 
@@ -92,7 +92,3 @@ os windows? cpu x86.64? and [
         ] with-db
     ] unit-test
 ] unless
-
-
-: with-dummy-db ( quot -- )
-    [ T{ postgresql-db } db ] dip with-variable ;

diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor
index 90a875b8fff6f4992731f1073ffd538d79a596e5..a094fbc542ac3ca1eace837be31a95615f04f38e 100644 (file)
--- a/basis/db/postgresql/postgresql.factor
+++ b/basis/db/postgresql/postgresql.factor
@@ -4,23 +4,31 @@ USING: arrays assocs alien alien.syntax continuations io
 kernel math math.parser namespaces make prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi
 db.tuples db.types tools.annotations math.ranges
-combinators classes locals words tools.walker
+combinators classes locals words tools.walker db.private
 nmake accessors random db.queries destructors db.tuples.private ;
 USE: tools.walker
 IN: db.postgresql
 
-TUPLE: postgresql-db < db
-    host port pgopts pgtty database username password ;
+TUPLE: postgresql-db host port pgopts pgtty database username password ;
 
 : <postgresql-db> ( -- postgresql-db )
-    postgresql-db new-db ;
+    postgresql-db new ;
+
+<PRIVATE
+
+TUPLE: postgresql-db-connection < db-connection ;
+: <postgresql-db-connection> ( handle -- db-connection )
+    postgresql-db-connection new-db-connection
+        swap >>handle ;
+
+PRIVATE>
 
 TUPLE: postgresql-statement < statement ;
 
 TUPLE: postgresql-result-set < result-set ;
 
-M: postgresql-db db-open ( db -- db )
-    dup {
+M: postgresql-db db-open ( db -- db-connection )
+    {
         [ host>> ]
         [ port>> ]
         [ pgopts>> ]
@@ -28,10 +36,9 @@ M: postgresql-db db-open ( db -- db )
         [ database>> ]
         [ username>> ]
         [ password>> ]
-    } cleave connect-postgres >>handle ;
+    } cleave connect-postgres <postgresql-db-connection> ;
 
-M: postgresql-db db-close ( handle -- )
-    PQfinish ;
+M: postgresql-db-connection db-close ( handle -- ) PQfinish ;
 
 M: postgresql-statement bind-statement* ( statement -- ) drop ;
 
@@ -98,25 +105,25 @@ M: postgresql-result-set dispose ( result-set -- )
 
 M: postgresql-statement prepare-statement ( statement -- )
     dup
-    [ db get handle>> f ] dip
+    [ db-connection get handle>> f ] dip
     [ sql>> ] [ in-params>> ] bi
     length f PQprepare postgresql-error
     >>handle drop ;
 
-M: postgresql-db <simple-statement> ( sql in out -- statement )
+M: postgresql-db-connection <simple-statement> ( sql in out -- statement )
     postgresql-statement new-statement ;
 
-M: postgresql-db <prepared-statement> ( sql in out -- statement )
+M: postgresql-db-connection <prepared-statement> ( sql in out -- statement )
     <simple-statement> dup prepare-statement ;
 
 : bind-name% ( -- )
     CHAR: $ 0,
     sql-counter [ inc ] [ get 0# ] bi ;
 
-M: postgresql-db bind% ( spec -- )
+M: postgresql-db-connection bind% ( spec -- )
     bind-name% 1, ;
 
-M: postgresql-db bind# ( spec object -- )
+M: postgresql-db-connection bind# ( spec object -- )
     [ bind-name% f swap type>> ] dip
     <literal-bind> 1, ;
 
@@ -162,7 +169,7 @@ M: postgresql-db bind# ( spec object -- )
         "_seq'');' language sql;" 0%
     ] query-make ;
 
-M: postgresql-db create-sql-statement ( class -- seq )
+M: postgresql-db-connection create-sql-statement ( class -- seq )
     [
         [ create-table-sql , ] keep
         dup db-assigned? [ create-function-sql , ] [ drop ] if
@@ -182,13 +189,13 @@ M: postgresql-db create-sql-statement ( class -- seq )
         "drop table " 0% 0% drop
     ] query-make ;
 
-M: postgresql-db drop-sql-statement ( class -- seq )
+M: postgresql-db-connection drop-sql-statement ( class -- seq )
     [
         [ drop-table-sql , ] keep
         dup db-assigned? [ drop-function-sql , ] [ drop ] if
     ] { } make ;
 
-M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
+M: postgresql-db-connection <insert-db-assigned-statement> ( class -- statement )
     [
         "select add_" 0% 0%
         "(" 0%
@@ -198,7 +205,7 @@ M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
         ");" 0%
     ] query-make ;
 
-M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
+M: postgresql-db-connection <insert-user-assigned-statement> ( class -- statement )
     [
         "insert into " 0% 0%
         "(" 0%
@@ -221,10 +228,10 @@ M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
         ");" 0%
     ] query-make ;
 
-M: postgresql-db insert-tuple-set-key ( tuple statement -- )
+M: postgresql-db-connection insert-tuple-set-key ( tuple statement -- )
     query-modify-tuple ;
 
-M: postgresql-db persistent-table ( -- hashtable )
+M: postgresql-db-connection persistent-table ( -- hashtable )
     H{
         { +db-assigned-id+ { "integer" "serial" f } }
         { +user-assigned-id+ { f f f } }
@@ -264,7 +271,7 @@ M: postgresql-db persistent-table ( -- hashtable )
     } ;
 
 ERROR: no-compound-found string object ;
-M: postgresql-db compound ( string object -- string' )
+M: postgresql-db-connection compound ( string object -- string' )
     over {
         { "default" [ first number>string " " glue ] }
         { "varchar" [ first number>string "(" ")" surround append ] }

diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor
index a96398ff2c88c93be25c58583ead3f50386a6927..2d7ea67107147ea23b6ae89e33a99780304d34fb 100644 (file)
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@@ -3,7 +3,8 @@
 USING: accessors kernel math namespaces make sequences random
 strings math.parser math.intervals combinators math.bitwise
 nmake db db.tuples db.types classes words shuffle arrays
-destructors continuations db.tuples.private prettyprint ;
+destructors continuations db.tuples.private prettyprint
+db.private ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )
@@ -62,7 +63,7 @@ M: retryable execute-statement* ( statement type -- )
         dup column-name>> 0% " = " 0% bind%
     ] interleave ;
 
-M: db <update-tuple-statement> ( class -- statement )
+M: db-connection <update-tuple-statement> ( class -- statement )
     [
         "update " 0% 0%
         " set " 0%
@@ -142,7 +143,7 @@ M: string where ( spec obj -- ) object-where ;
 : where-clause ( tuple specs -- )
     dupd filter-slots [ drop ] [ many-where ] if-empty ;
 
-M: db <delete-tuples-statement> ( tuple table -- sql )
+M: db-connection <delete-tuples-statement> ( tuple table -- sql )
     [
         "delete from " 0% 0%
         where-clause
@@ -150,7 +151,7 @@ M: db <delete-tuples-statement> ( tuple table -- sql )
 
 ERROR: all-slots-ignored class ;
 
-M: db <select-by-slots-statement> ( tuple class -- statement )
+M: db-connection <select-by-slots-statement> ( tuple class -- statement )
     [
         "select " 0%
         [ dupd filter-ignores ] dip
@@ -185,13 +186,13 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
         [ offset>> [ do-offset ] [ drop ] if* ]
     } 2cleave ;
 
-M: db query>statement ( query -- tuple )
+M: db-connection query>statement ( query -- tuple )
     [ tuple>> dup class ] keep
     [ <select-by-slots-statement> ] dip make-query* ;
 
 ! select ID, NAME, SCORE from EXAM limit 1 offset 3
 
-M: db <count-statement> ( query -- statement )
+M: db-connection <count-statement> ( query -- statement )
     [ tuple>> dup class ] keep
     [ [ "select count(*) from " 0% 0% where-clause ] query-make ]
     dip make-query* ;

diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor
index fd0d1131d7473586668bff421f23647bedd018a8..b1bc9aa1a218933a4b93e79db6128d29c5e630df 100644 (file)
--- a/basis/db/sqlite/lib/lib.factor
+++ b/basis/db/sqlite/lib/lib.factor
@@ -5,7 +5,8 @@ namespaces sequences db.sqlite.ffi db combinators
 continuations db.types calendar.format serialize
 io.streams.byte-array byte-arrays io.encodings.binary
 io.backend db.errors present urls io.encodings.utf8
-io.encodings.string accessors shuffle ;
+io.encodings.string accessors shuffle io prettyprint
+db.private ;
 IN: db.sqlite.lib
 
 ERROR: sqlite-error < db-error n string ;
@@ -16,7 +17,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
 
 : sqlite-statement-error ( -- * )
     SQLITE_ERROR
-    db get handle>> sqlite3_errmsg sqlite-sql-error ;
+    db-connection get handle>> sqlite3_errmsg sqlite-sql-error ;
 
 : sqlite-check-result ( n -- )
     {
@@ -124,7 +125,8 @@ ERROR: sqlite-sql-error < sql-error n string ;
     ] if* (sqlite-bind-type) ;
 
 : sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
-: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
+: sqlite-reset ( handle -- )
+"resetting: " write dup . sqlite3_reset sqlite-check-result ;
 : sqlite-clear-bindings ( handle -- )
     sqlite3_clear_bindings sqlite-check-result ;
 : sqlite-#columns ( query -- int ) sqlite3_column_count ;

diff --git a/basis/db/sqlite/sqlite-tests.factor b/basis/db/sqlite/sqlite-tests.factor
index b816e414baaf4ec442e088690ec1614d81324b23..6fb1cd19adccb262b943a4bbad49ccfaa90135e5 100644 (file)
--- a/basis/db/sqlite/sqlite-tests.factor
+++ b/basis/db/sqlite/sqlite-tests.factor
@@ -3,8 +3,8 @@ kernel namespaces prettyprint tools.test db.sqlite db sequences
 continuations db.types db.tuples unicode.case ;
 IN: db.sqlite.tests
 
-: db-path "test.db" temp-file ;
-: test.db db-path <sqlite-db> ;
+: db-path ( -- path ) "test.db" temp-file ;
+: test.db ( -- sqlite-db ) db-path <sqlite-db> ;
 
 [ ] [ [ db-path delete-file ] ignore-errors ] unit-test
 

diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor
index 32c5ca00752149fd24a07266188cc8083dc6f6f5..0f545030a33dc9d930b70aeeccf51cf24ca38b95 100644 (file)
--- a/basis/db/sqlite/sqlite.factor
+++ b/basis/db/sqlite/sqlite.factor
@@ -6,33 +6,43 @@ sequences strings classes.tuple alien.c-types continuations
 db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators
 math.intervals io nmake accessors vectors math.ranges random
 math.bitwise db.queries destructors db.tuples.private interpolate
-io.streams.string multiline make ;
+io.streams.string multiline make db.private ;
 IN: db.sqlite
 
-TUPLE: sqlite-db < db path ;
+TUPLE: sqlite-db path ;
 
 : <sqlite-db> ( path -- sqlite-db )
-    sqlite-db new-db
+    sqlite-db new
         swap >>path ;
 
-M: sqlite-db db-open ( db -- db )
-    dup path>> sqlite-open >>handle ;
+<PRIVATE
 
-M: sqlite-db db-close ( handle -- ) sqlite-close ;
+TUPLE: sqlite-db-connection < db-connection ;
+
+: <sqlite-db-connection> ( handle -- db-connection )
+    sqlite-db-connection new-db-connection
+        swap >>handle ;
+
+PRIVATE>
+
+M: sqlite-db db-open ( db -- db-connection )
+    path>> sqlite-open <sqlite-db-connection> ;
+
+M: sqlite-db-connection db-close ( handle -- ) sqlite-close ;
 
 TUPLE: sqlite-statement < statement ;
 
 TUPLE: sqlite-result-set < result-set has-more? ;
 
-M: sqlite-db <simple-statement> ( str in out -- obj )
+M: sqlite-db-connection <simple-statement> ( str in out -- obj )
     <prepared-statement> ;
 
-M: sqlite-db <prepared-statement> ( str in out -- obj )
+M: sqlite-db-connection <prepared-statement> ( str in out -- obj )
     sqlite-statement new-statement ;
 
 : sqlite-maybe-prepare ( statement -- statement )
     dup handle>> [
-        db get handle>> over sql>> sqlite-prepare
+        db-connection get handle>> over sql>> sqlite-prepare
         >>handle
     ] unless ;
 
@@ -89,10 +99,10 @@ M: sqlite-statement bind-tuple ( tuple statement -- )
 ERROR: sqlite-last-id-fail ;
 
 : last-insert-id ( -- id )
-    db get handle>> sqlite3_last_insert_rowid
+    db-connection get handle>> sqlite3_last_insert_rowid
     dup zero? [ sqlite-last-id-fail ] when ;
 
-M: sqlite-db insert-tuple-set-key ( tuple statement -- )
+M: sqlite-db-connection insert-tuple-set-key ( tuple statement -- )
     execute-statement last-insert-id swap set-primary-key ;
 
 M: sqlite-result-set #columns ( result-set -- n )
@@ -116,7 +126,7 @@ M: sqlite-statement query-results ( query -- result-set )
     dup handle>> sqlite-result-set new-result-set
     dup advance-row ;
 
-M: sqlite-db create-sql-statement ( class -- statement )
+M: sqlite-db-connection create-sql-statement ( class -- statement )
     [
         dupd
         "create table " 0% 0%
@@ -135,10 +145,10 @@ M: sqlite-db create-sql-statement ( class -- statement )
         "));" 0%
     ] query-make ;
 
-M: sqlite-db drop-sql-statement ( class -- statement )
+M: sqlite-db-connection drop-sql-statement ( class -- statement )
     [ "drop table " 0% 0% ";" 0% drop ] query-make ;
 
-M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
+M: sqlite-db-connection <insert-db-assigned-statement> ( tuple -- statement )
     [
         "insert into " 0% 0%
         "(" 0%
@@ -159,19 +169,19 @@ M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
         ");" 0%
     ] query-make ;
 
-M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
+M: sqlite-db-connection <insert-user-assigned-statement> ( tuple -- statement )
     <insert-db-assigned-statement> ;
 
-M: sqlite-db bind# ( spec obj -- )
+M: sqlite-db-connection bind# ( spec obj -- )
     [
         [ column-name>> ":" next-sql-counter surround dup 0% ]
         [ type>> ] bi
     ] dip <literal-bind> 1, ;
 
-M: sqlite-db bind% ( spec -- )
+M: sqlite-db-connection bind% ( spec -- )
     dup 1, column-name>> ":" prepend 0% ;
 
-M: sqlite-db persistent-table ( -- assoc )
+M: sqlite-db-connection persistent-table ( -- assoc )
     H{
         { +db-assigned-id+ { "integer" "integer" f } }
         { +user-assigned-id+ { f f f } }
@@ -306,7 +316,7 @@ M: sqlite-db persistent-table ( -- assoc )
         delete-trigger-restrict sqlite-trigger,
     ] if ;
 
-M: sqlite-db compound ( string seq -- new-string )
+M: sqlite-db-connection compound ( string seq -- new-string )
     over {
         { "default" [ first number>string " " glue ] }
         { "references" [

diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor
index b834c2c9909a399608e49b8c69927b680b82507e..246946c7151717fc9887532c8d767cb6ece12f21 100644 (file)
--- a/basis/db/tuples/tuples-tests.factor
+++ b/basis/db/tuples/tuples-tests.factor
@@ -4,7 +4,7 @@ USING: io.files io.files.temp kernel tools.test db db.tuples classes
 db.types continuations namespaces math math.ranges
 prettyprint calendar sequences db.sqlite math.intervals
 db.postgresql accessors random math.bitwise system
-math.ranges strings urls fry db.tuples.private ;
+math.ranges strings urls fry db.tuples.private db.private ;
 IN: db.tuples.tests
 
 : sqlite-db ( -- sqlite-db )
@@ -33,10 +33,10 @@ IN: db.tuples.tests
 
 ! These words leak resources, but are useful for interactivel testing 
 : sqlite-test-db ( -- )
-    sqlite-db db-open db set ;
+    sqlite-db db-open db-connection set ;
 
 : postgresql-test-db ( -- )
-    postgresql-db db-open db set ;
+    postgresql-db db-open db-connection set ;
 
 TUPLE: person the-id the-name the-number the-real
 ts date time blob factor-blob url ;

diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor
index 7a5c9e41e68b87d2c8e28cc9f7df0b16f143ed89..d2116058d8d8972f51742a0760861063c2c8e46a 100644 (file)
--- a/basis/db/tuples/tuples.factor
+++ b/basis/db/tuples/tuples.factor
@@ -3,20 +3,20 @@
 USING: arrays assocs classes db kernel namespaces
 classes.tuple words sequences slots math accessors
 math.parser io prettyprint db.types continuations
-destructors mirrors sets db.types ;
+destructors mirrors sets db.types db.private ;
 IN: db.tuples
 
-HOOK: create-sql-statement db ( class -- object )
-HOOK: drop-sql-statement db ( class -- object )
+HOOK: create-sql-statement db-connection ( class -- object )
+HOOK: drop-sql-statement db-connection ( class -- object )
 
-HOOK: <insert-db-assigned-statement> db ( class -- object )
-HOOK: <insert-user-assigned-statement> db ( class -- object )
-HOOK: <update-tuple-statement> db ( class -- object )
-HOOK: <delete-tuples-statement> db ( tuple class -- object )
-HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
-HOOK: <count-statement> db ( query -- statement )
-HOOK: query>statement db ( query -- statement )
-HOOK: insert-tuple-set-key db ( tuple statement -- )
+HOOK: <insert-db-assigned-statement> db-connection ( class -- object )
+HOOK: <insert-user-assigned-statement> db-connection ( class -- object )
+HOOK: <update-tuple-statement> db-connection ( class -- object )
+HOOK: <delete-tuples-statement> db-connection ( tuple class -- object )
+HOOK: <select-by-slots-statement> db-connection ( tuple class -- tuple )
+HOOK: <count-statement> db-connection ( query -- statement )
+HOOK: query>statement db-connection ( query -- statement )
+HOOK: insert-tuple-set-key db-connection ( tuple statement -- )
 
 <PRIVATE
 
@@ -52,12 +52,14 @@ GENERIC: eval-generator ( singleton -- object )
 
 : insert-db-assigned-statement ( tuple -- )
     dup class
-    db get insert-statements>> [ <insert-db-assigned-statement> ] cache
+    db-connection get insert-statements>>
+    [ <insert-db-assigned-statement> ] cache
     [ bind-tuple ] 2keep insert-tuple-set-key ;
 
 : insert-user-assigned-statement ( tuple -- )
     dup class
-    db get insert-statements>> [ <insert-user-assigned-statement> ] cache
+    db-connection get insert-statements>>
+    [ <insert-user-assigned-statement> ] cache
     [ bind-tuple ] keep execute-statement ;
 
 : do-select ( exemplar-tuple statement -- tuples )
@@ -117,7 +119,7 @@ M: tuple >query <query> swap >>tuple ;
 
 : update-tuple ( tuple -- )
     dup class
-    db get update-statements>> [ <update-tuple-statement> ] cache
+    db-connection get update-statements>> [ <update-tuple-statement> ] cache
     [ bind-tuple ] keep execute-statement ;
 
 : delete-tuples ( tuple -- )

diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor
index a8b952088a1cd97693e3a77037b8e711eebb7e1b..33b89233476b5a19d558423366f2db19d051ddb0 100644 (file)
--- a/basis/db/types/types.factor
+++ b/basis/db/types/types.factor
@@ -3,12 +3,12 @@
 USING: arrays assocs db kernel math math.parser
 sequences continuations sequences.deep prettyprint
 words namespaces slots slots.private classes mirrors
-classes.tuple combinators calendar.format
-accessors quotations random ;
+classes.tuple combinators calendar.format classes.singleton
+accessors quotations random db.private ;
 IN: db.types
 
-HOOK: persistent-table db ( -- hash )
-HOOK: compound db ( string obj -- hash )
+HOOK: persistent-table db-connection ( -- hash )
+HOOK: compound db-connection ( string obj -- hash )
 
 TUPLE: sql-spec class slot-name column-name type primary-key modifiers ;
 
@@ -158,8 +158,8 @@ ERROR: no-sql-type type ;
     modifiers>> [ lookup-modifier ] map " " join
     [ "" ] [ " " prepend ] if-empty ;
 
-HOOK: bind% db ( spec -- )
-HOOK: bind# db ( spec obj -- )
+HOOK: bind% db-connection ( spec -- )
+HOOK: bind# db-connection ( spec obj -- )
 
 ERROR: no-column column ;