Add first cut at sqlite library.

diff --git a/contrib/sqlite/sqlite.factor b/contrib/sqlite/sqlite.factor
new file mode 100644 (file)
index 0000000..3dee2a3
--- /dev/null
+++ b/contrib/sqlite/sqlite.factor
@@ -0,0 +1,245 @@
+! Copyright (C) 2005 Chris Double.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+!
+! An interface to the sqlite database. Tested against sqlite v3.0.8.
+! Remeber to pass the following to factor:
+!  -libraries:sqlite=libsqlite3.so
+!
+! Not all functions have been wrapped yet. Only those directly involving
+! executing SQL calls and obtaining results.
+!
+! TODO: Do I have to free stuctures like <sqlite3> and <char*>, etc
+!       or do they get freed on garbage collection?
+!       How do I do pointers to pointers? Use the 'indirect' trick?
+!
+IN: sqlite
+USE: kernel
+USE: alien
+USE: compiler
+USE: errors
+USE: strings
+USE: namespaces
+
+BEGIN-STRUCT: sqlite3
+END-STRUCT
+
+BEGIN-STRUCT: sqlite3-indirect
+  FIELD: sqlite3* pointer
+END-STRUCT
+
+BEGIN-STRUCT: sqlite3-stmt
+END-STRUCT
+
+BEGIN-STRUCT: sqlite3-stmt-indirect
+  FIELD: sqlite3-stmt* pointer
+END-STRUCT
+
+BEGIN-STRUCT: char*-indirect
+  FIELD: char* pointer
+END-STRUCT
+
+! Return values from sqlite functions
+: SQLITE_OK           0   ; ! Successful result
+: SQLITE_ERROR        1   ; ! SQL error or missing database
+: SQLITE_INTERNAL     2   ; ! An internal logic error in SQLite 
+: SQLITE_PERM         3   ; ! Access permission denied 
+: SQLITE_ABORT        4   ; ! Callback routine requested an abort 
+: SQLITE_BUSY         5   ; ! The database file is locked 
+: SQLITE_LOCKED       6   ; ! A table in the database is locked 
+: SQLITE_NOMEM        7   ; ! A malloc() failed 
+: SQLITE_READONLY     8   ; ! Attempt to write a readonly database 
+: SQLITE_INTERRUPT    9   ; ! Operation terminated by sqlite_interrupt() 
+: SQLITE_IOERR       10   ; ! Some kind of disk I/O error occurred 
+: SQLITE_CORRUPT     11   ; ! The database disk image is malformed 
+: SQLITE_NOTFOUND    12   ; ! (Internal Only) Table or record not found 
+: SQLITE_FULL        13   ; ! Insertion failed because database is full 
+: SQLITE_CANTOPEN    14   ; ! Unable to open the database file 
+: SQLITE_PROTOCOL    15   ; ! Database lock protocol error 
+: SQLITE_EMPTY       16   ; ! (Internal Only) Database table is empty 
+: SQLITE_SCHEMA      17   ; ! The database schema changed 
+: SQLITE_TOOBIG      18   ; ! Too much data for one row of a table 
+: SQLITE_CONSTRAINT  19   ; ! Abort due to contraint violation 
+: SQLITE_MISMATCH    20   ; ! Data type mismatch 
+: SQLITE_MISUSE      21   ; ! Library used incorrectly 
+: SQLITE_NOLFS       22   ; ! Uses OS features not supported on host 
+: SQLITE_AUTH        23   ; ! Authorization denied 
+: SQLITE_ROW         100  ; ! sqlite_step() has another row ready 
+: SQLITE_DONE        101  ; ! sqlite_step() has finished executing 
+
+! Return values from the sqlite3_column_type function
+: SQLITE_INTEGER     1 ;
+: SQLITE_FLOAT       2 ;
+: SQLITE_TEXT        3 ;
+: SQLITE_BLOB        4 ;
+: SQLITE_NULL        5 ;
+
+! Values for the 'destructor' parameter of the 'bind' routines. 
+: SQLITE_STATIC      0  ;
+: SQLITE_TRANSIENT   -1 ;
+
+: sqlite3_open ( filename sqlite3-indirect -- result )
+  "int" "sqlite" "sqlite3_open" [ "char*" "sqlite3-indirect*" ] alien-invoke ;
+
+: sqlite3_close ( db -- )
+  "int" "sqlite" "sqlite3_close" [ "sqlite3*" ] alien-invoke ;
+
+: sqlite3_prepare ( db sql sql-len sqlite3-stmt-indirect tail -- result )
+  "int" "sqlite" "sqlite3_prepare" [ "sqlite3*" "char*" "int" "sqlite3-stmt-indirect*" "char*-indirect*" ] alien-invoke ;
+
+: sqlite3_finalize ( stmt -- result ) 
+  "int" "sqlite" "sqlite3_finalize" [ "sqlite3-stmt*" ] alien-invoke ;
+
+: sqlite3_reset ( stmt -- result )
+  "int" "sqlite" "sqlite3_reset" [ "sqlite3-stmt*" ] alien-invoke ;
+
+: sqlite3_step ( stmt -- result )
+  "int" "sqlite" "sqlite3_step" [ "sqlite3-stmt*" ] alien-invoke ;
+
+: sqlite3_bind_blob ( stmt index pointer len destructor -- result )
+  "int" "sqlite" "sqlite3_bind_blob" [ "sqlite3-stmt*" "int" "void*" "int" "int" ] alien-invoke ;
+
+: sqlite3_bind_int ( stmt index int -- result )
+  "int" "sqlite" "sqlite3_bind_int" [ "sqlite3-stmt*" "int" "int" ] alien-invoke ;
+
+: sqlite3_bind_null ( stmt index  -- result )
+  "int" "sqlite" "sqlite3_bind_null" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+
+: sqlite3_bind_text ( stmt index text len destructor -- result )
+  "int" "sqlite" "sqlite3_bind_text" [ "sqlite3-stmt*" "int" "char*" "int" "int" ] alien-invoke ;
+
+: sqlite3_column_count ( stmt -- count )
+  "int" "sqlite" "sqlite3_column_count" [ "sqlite3-stmt*" ] alien-invoke ;
+
+: sqlite3_column_blob ( stmt col -- void* )
+  "void*" "sqlite" "sqlite3_column_blob" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+
+: sqlite3_column_bytes ( stmt col -- int )
+  "int" "sqlite" "sqlite3_column_bytes" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+
+: sqlite3_column_decltype ( stmt col -- string )
+  "char*" "sqlite" "sqlite3_column_decltype" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+
+: sqlite3_column_int ( stmt col -- int )
+  "int" "sqlite" "sqlite3_column_int" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+
+: sqlite3_column_name ( stmt col -- string )
+  "char*" "sqlite" "sqlite3_column_name" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+
+: sqlite3_column_text ( stmt col -- string )
+  "char*" "sqlite" "sqlite3_column_text" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+
+: sqlite3_column_type ( stmt col -- int )
+  "int" "sqlite" "sqlite3_column_type" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+
+\ sqlite3_open compile
+\ sqlite3_close compile
+\ sqlite3_prepare compile
+\ sqlite3_finalize compile
+\ sqlite3_reset compile
+\ sqlite3_bind_blob compile
+\ sqlite3_bind_int compile
+\ sqlite3_bind_null compile
+\ sqlite3_bind_text compile
+\ sqlite3_step compile
+\ sqlite3_column_count compile
+\ sqlite3_column_blob compile
+\ sqlite3_column_bytes compile
+\ sqlite3_column_decltype compile
+\ sqlite3_column_int compile
+\ sqlite3_column_name compile
+\ sqlite3_column_text compile
+\ sqlite3_column_type compile
+
+! High level sqlite routines
+: sqlite-check-result ( result -- )
+  #! Check the result from a sqlite call is ok. If it is
+  #! return, otherwise throw an error. TODO: Throw the actual
+  #! error text message.
+  dup SQLITE_OK = [
+    drop 
+  ] [
+    "sqlite returned an error. See datastack for the error value." throw
+  ] ifte ;
+
+: sqlite-open ( filename -- db )
+  #! Open the database referenced by the filename and return
+  #! a handle to that database. An error is thrown if the database
+  #! failed to open.
+  <sqlite3-indirect> tuck sqlite3_open sqlite-check-result sqlite3-indirect-pointer ;
+
+: sqlite-close ( db -- )
+  #! Close the given database
+  sqlite3_close sqlite-check-result ;
+
+: sqlite-prepare ( db sql -- statement )
+  #! Prepare a SQL statement. Returns the statement which
+  #! can have values bound to parameters or simply executed.
+  #! TODO: Support multiple statements in the SQL string.
+  dup str-length <sqlite3-stmt-indirect> dup >r 
+  <char*-indirect> sqlite3_prepare sqlite-check-result
+  r> sqlite3-stmt-indirect-pointer ;
+    
+: sqlite-finalize ( statement -- )
+  #! Clean up all resources related to a statement. Once called
+  #! the statement cannot be used. All statements must be finalized
+  #! before closing the database.
+  sqlite3_finalize sqlite-check-result ;
+
+: sqlite-reset ( statement -- )
+  #! Reset a statement so it can be called again, possibly with
+  #! different parameters.
+  sqlite3_reset sqlite-check-result ;
+
+: column-count ( statement -- int )
+  #! Given a prepared statement, return the number of
+  #! columns in each row of the result set of that statement.
+  sqlite3_column_count ;
+
+: column-text ( statement column -- string )
+  #! Return the value of the given column, indexed
+  #! from zero, as a string.
+  sqlite3_column_text ;
+
+: (sqlite-each) 
+  "statement" get sqlite3_step dup SQLITE_ROW = [
+    drop
+    "statement" get "quot" get call (sqlite-each)
+  ] [ 
+    dup SQLITE_DONE = [
+      drop
+    ] [
+      sqlite-check-result
+    ] ifte 
+  ] ifte ;
+
+: sqlite-each ( statement quot -- )    
+  #! Excecute the SQL statement, and call the quotation for
+  #! each row returned from executing the statement with the
+  #! statement on the top of the stack.
+  #! TODO: Implement without named parameters
+  <namespace> [
+    "quot" set
+    "statement" set
+    (sqlite-each)
+  ] bind ;
+

diff --git a/contrib/sqlite/test.factor b/contrib/sqlite/test.factor
new file mode 100644 (file)
index 0000000..8257c65
--- /dev/null
+++ b/contrib/sqlite/test.factor
@@ -0,0 +1,50 @@
+! Copyright (C) 2005 Chris Double.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+!
+! Test the sqlite interface
+!
+! Create a test database like follows:
+!
+!   sqlite3 test.db
+!   > create table test (name varchar(30), address varchar(30));
+!   > insert into test values('John', 'America');
+!   > insert into test values('Jane', 'New Zealand');
+!   > [eof]
+!
+!  Then run this file.
+USE: sqlite
+USE: kernel
+USE: stdio
+USE: prettyprint
+
+: show-people ( statement -- )
+  dup 0 column-text write " from " write 1 column-text . ;
+
+: run-test ( -- )
+  "test.db" sqlite-open
+  dup "select * from test" sqlite-prepare
+  dup [ show-people ] sqlite-each 
+  sqlite-finalize
+  sqlite-close ;
+
+run-test
\ No newline at end of file