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

refactor a bit of sqlite 

fix inheritance test in tuple-db
db4
Doug Coleman 2008-05-30 19:21:20 -05:00
parent 65f30a07a1
commit cf0ed665bf
3 changed files with 11 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
extra/db/sqlite/lib/lib.factor
View File

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

3
extra/db/sqlite/sqlite.factor
View File

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

10
extra/db/tuples/tuples.factor
View File

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