steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Doug Coleman 2008-09-02 22:50:46 -05:00
parent 9dedd5698f
commit b23ac6f137
8 changed files with 29 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/db/db-tests.factor
View File

@ -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

25
basis/db/db.factor
View File

@ -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 -- )

1
basis/db/errors/errors.factor
View File

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

2
basis/db/postgresql/postgresql.factor
View File

@ -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

6
basis/db/sqlite/ffi/ffi.factor
View File

@ -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 ) ;

3
basis/db/sqlite/sqlite-tests.factor
View File

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

2
basis/db/sqlite/sqlite.factor
View File

@ -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 ;

24
basis/db/types/types.factor
View File

@ -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>> ;