about to consolidate sql types/create types/modifiers

diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor
index bcf71ea95f1abd7c1d7376756ca1ef7d2a1ba554..5f98720de018eb93cd7f645aaa39690684eeef83 100755 (executable)
--- a/extra/db/postgresql/postgresql.factor
+++ b/extra/db/postgresql/postgresql.factor
@@ -93,7 +93,7 @@ M: postgresql-result-set dispose ( result-set -- )
 
 M: postgresql-statement prepare-statement ( statement -- )
     dup
-    >r db get handle>> "" r>
+    >r db get handle>> f r>
     [ sql>> ] [ in-params>> ] bi
     length f PQprepare postgresql-error
     >>handle drop ;
@@ -274,21 +274,6 @@ M: postgresql-db create-type-table ( -- hash )
         { +random-id+ "bigint primary key" }
     } ;
 
-: postgresql-compound ( str n -- newstr )
-    over {
-        { "default" [ first number>string join-space ] }
-        { "varchar" [ first number>string paren append ] }
-        { "references" [
-                first2 >r [ unparse join-space ] keep db-columns r>
-                swap [ slot-name>> = ] with find nip
-                column-name>> paren append
-            ] }
-        [ "no compound found" 3array throw ]
-    } case ;
-
-M: postgresql-db compound-modifier ( str seq -- newstr )
-    postgresql-compound ;
-    
 M: postgresql-db modifier-table ( -- hashtable )
     H{
         { +native-id+ "primary key" }
@@ -305,5 +290,14 @@ M: postgresql-db modifier-table ( -- hashtable )
         { random-generator "" }
     } ;
 
-M: postgresql-db compound-type ( str n -- newstr )
-    postgresql-compound ;
+M: postgresql-db compound ( str obj -- str' )
+    over {
+        { "default" [ first number>string join-space ] }
+        { "varchar" [ first number>string paren append ] }
+        { "references" [
+                first2 >r [ unparse join-space ] keep db-columns r>
+                swap [ slot-name>> = ] with find nip
+                column-name>> paren append
+            ] }
+        [ "no compound found" 3array throw ]
+    } case ;

diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index f361e18c48f7e45983dbe10181552b6767946190..fb3fbe92bebe6fc9098187a5c62418ae6074b0fe 100755 (executable)
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -110,7 +110,6 @@ M: sqlite-db begin-transaction ( -- ) "BEGIN" sql-command ;
 M: sqlite-db commit-transaction ( -- ) "COMMIT" sql-command ;
 M: sqlite-db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
 
-
 : maybe-make-retryable ( statement -- statement )
     dup in-params>> [ generator-bind? ] contains? [
         make-retryable
@@ -263,14 +262,6 @@ M: sqlite-db modifier-table ( -- hashtable )
         { random-generator "" }
     } ;
 
-M: sqlite-db compound-modifier ( str obj -- str' ) compound-type ;
-
-M: sqlite-db compound-type ( str seq -- str' )
-    over {
-        { "default" [ first number>string join-space ] }
-        [ 2drop ] 
-    } case ;
-
 M: sqlite-db type-table ( -- assoc )
     H{
         { +native-id+ "integer primary key" }
@@ -291,3 +282,10 @@ M: sqlite-db type-table ( -- assoc )
     } ;
 
 M: sqlite-db create-type-table ( symbol -- str ) type-table ;
+
+M: sqlite-db compound ( str seq -- str' )
+    over {
+        { "default" [ first number>string join-space ] }
+        [ 2drop ] 
+    } case ;
+

diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor
index 41db970b12635e3086a8e407e42a7351bb960513..80e11e7afbcc95a510d53539ac5fbad19c3fb05b 100755 (executable)
--- a/extra/db/types/types.factor
+++ b/extra/db/types/types.factor
@@ -8,10 +8,9 @@ classes.singleton accessors quotations random ;
 IN: db.types
 
 HOOK: modifier-table db ( -- hash )
-HOOK: compound-modifier db ( str seq -- hash )
+HOOK: compound db ( str obj -- hash )
 HOOK: type-table db ( -- hash )
 HOOK: create-type-table db ( -- hash )
-HOOK: compound-type db ( str n -- hash )
 HOOK: random-id-quot db ( -- quot )
 
 TUPLE: sql-spec class slot-name column-name type primary-key modifiers ;
@@ -100,7 +99,7 @@ ERROR: unknown-modifier ;
 
 : lookup-modifier ( obj -- str )
     {
-        { [ dup array? ] [ unclip lookup-modifier swap compound-modifier ] }
+        { [ dup array? ] [ unclip lookup-modifier swap compound ] }
         [ modifier-table at* [ unknown-modifier ] unless ]
     } cond ;
 
@@ -115,7 +114,7 @@ ERROR: no-sql-type ;
 
 : lookup-create-type ( obj -- str )
     dup array? [
-        unclip lookup-create-type swap compound-type
+        unclip lookup-create-type swap compound
     ] [
         dup create-type-table at*
         [ nip ] [ drop lookup-type* ] if