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 ; dup sqlite-#columns [ sqlite-column ] with map ;
: sqlite-step-has-more-rows? ( prepared -- bool ) : sqlite-step-has-more-rows? ( prepared -- bool )
dup SQLITE_ROW = [ {
drop t { SQLITE_ROW [ t ] }
] [ { SQLITE_DONE [ f ] }
dup SQLITE_DONE = [ sqlite-check-result f ]
[ drop ] [ sqlite-check-result ] if f } case ;
] if ;
: sqlite-next ( prepared -- ? ) : sqlite-next ( prepared -- ? )
sqlite3_step sqlite-step-has-more-rows? ; 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 ; swap >>path ;
M: sqlite-db db-open ( db -- db ) 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 db-close ( handle -- ) sqlite-close ;
M: sqlite-db dispose ( db -- ) dispose-db ; M: sqlite-db dispose ( db -- ) dispose-db ;
@ -197,4 +197,3 @@ M: sqlite-db compound ( str seq -- str' )
{ "default" [ first number>string join-space ] } { "default" [ first number>string join-space ] }
[ 2drop ] [ 2drop ]
} case ; } 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 [ regenerate-params bind-statement* f ] cleanup
] curry 10 retry drop ; ] curry 10 retry drop ;
: resulting-tuple ( row out-params -- tuple ) : resulting-tuple ( class row out-params -- tuple )
dup peek class>> new [ rot class new [
[ [
>r slot-name>> r> set-slot-named >r slot-name>> r> set-slot-named
] curry 2each ] curry 2each
] keep ; ] keep ;
: query-tuples ( statement -- seq ) : query-tuples ( exemplar-tuple statement -- seq )
[ out-params>> ] keep query-results [ [ 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 ; ] with-disposal ;
: query-modify-tuple ( tuple statement -- ) : query-modify-tuple ( tuple statement -- )
@ -145,7 +145,7 @@ M: retryable execute-statement* ( statement type -- )
: select-tuples ( tuple -- tuples ) : select-tuples ( tuple -- tuples )
dup dup class <select-by-slots-statement> [ dup dup class <select-by-slots-statement> [
[ bind-tuple ] keep query-tuples [ bind-tuple ] [ query-tuples ] 2bi
] with-disposal ; ] with-disposal ;
: select-tuple ( tuple -- tuple/f ) select-tuples ?first ; : select-tuple ( tuple -- tuple/f ) select-tuples ?first ;