Changeset 15344 in project


Ignore:
Timestamp:
08/07/09 00:22:29 (10 years ago)
Author:
Thomas Chust
bzr:base-revision:
chust@web.de-20090806154120-2raf4ni32ue1x6vx
bzr:committer:
Thomas Chust <chust@web.de>
bzr:file-ids:

doc.scm 4989@fca3e652-9b03-0410-8d7b-ac86a6ce46c4:sqlite3%2Ftags%2F1.5.9%2Fdoc.scm
sqlite3.html 4989@fca3e652-9b03-0410-8d7b-ac86a6ce46c4:sqlite3%2Ftags%2F1.5.9%2Fsqlite3.html
sqlite3.meta 4989@fca3e652-9b03-0410-8d7b-ac86a6ce46c4:sqlite3%2Ftags%2F1.5.9%2Fsqlite3.meta
sqlite3.scm 4989@fca3e652-9b03-0410-8d7b-ac86a6ce46c4:sqlite3%2Ftags%2F1.5.9%2Fsqlite3.scm
tests/run.scm sqlite3.scm-20090806135642-4ijg0ujxlfdmodmf-2
bzr:mapping-version:
v4
bzr:merge:

chust@web.de-20090806223639-6e1xgb7n3glpk9nb
bzr:repository-uuid:
fca3e652-9b03-0410-8d7b-ac86a6ce46c4
bzr:revision-id:
chust@web.de-20090806223835-g0snt5f6wtkgrxwg
bzr:revno:
22
bzr:revprop:branch-nick:
release/4/sqlite3/trunk
bzr:root:
release/4/sqlite3/trunk
bzr:text-parents:

doc.scm chust@web.de-20090806144351-ew266bq108o4vbqu
sqlite3.html chust@web.de-20090806144351-ew266bq108o4vbqu
sqlite3.meta chust@web.de-20090806144351-ew266bq108o4vbqu
sqlite3.scm chust@web.de-20090806135452-oojz3c1m5ckhl4uk
tests/run.scm chust@web.de-20090806144351-ew266bq108o4vbqu
bzr:text-revisions:

doc.scm chust@web.de-20090806223639-6e1xgb7n3glpk9nb
sqlite3.html chust@web.de-20090806223639-6e1xgb7n3glpk9nb
sqlite3.meta chust@web.de-20090806223639-6e1xgb7n3glpk9nb
sqlite3.scm chust@web.de-20090806223639-6e1xgb7n3glpk9nb
tests/run.scm chust@web.de-20090806223639-6e1xgb7n3glpk9nb
bzr:timestamp:
2009-08-07 00:38:35.799000025 +0200
bzr:user-agent:
bzr1.17+bzr-svn0.6.3
svn:original-date:
2009-08-06T22:38:35.799000Z
Message:

sqlite3: Merged local code cleanups and switch to sql-null for NULL handling.

Location:
release/4/sqlite3/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • release/4/sqlite3/trunk/doc.scm

    r15334 r15344  
    1414    (usage)
    1515    (download "sqlite3.egg")
    16     (requires "check-errors" "synch" "miscmacros" "matchable")
     16    (requires "check-errors" "synch" "miscmacros" "matchable" "sql-null")
    1717
    1818    (documentation
     
    2323      (subsection "Exceptions"
    2424
    25   (p "Unless otherwise indicated, all procedures and methods in this egg may throw an exception of the kind " (tt "(exn sqlite3)") " if something goes wrong. This exception will contain a " (tt "status") " property indicating the return value of the operation that failed:"
    26   (table
    27     (tr (th "Symbol") (th "Meaning"))
    28     #;(tr (td (tt "ok")) (td "Successful result"))
    29     (tr (td (tt "error")) (td "SQL error or missing database "))
    30     (tr (td (tt "internal")) (td "An internal logic error in SQLite "))
    31     (tr (td (tt "permission")) (td "Access permission denied "))
    32     (tr (td (tt "abort")) (td "Callback routine requested an abort "))
    33     (tr (td (tt "busy")) (td "The database file is locked "))
    34     (tr (td (tt "locked")) (td "A table in the database is locked "))
    35     (tr (td (tt "no-memory")) (td "A malloc() failed "))
    36     (tr (td (tt "read-only")) (td "Attempt to write a readonly database "))
    37     (tr (td (tt "interrupt")) (td "Operation terminated by sqlite-interrupt() "))
    38     (tr (td (tt "io-error")) (td "Some kind of disk I/O error occurred "))
    39     (tr (td (tt "corrupt")) (td "The database disk image is malformed "))
    40     (tr (td (tt "not-found")) (td "(Internal Only) Table or record not found "))
    41     (tr (td (tt "full")) (td "Insertion failed because database is full "))
    42     (tr (td (tt "cant-open")) (td "Unable to open the database file "))
    43     (tr (td (tt "protocol")) (td "Database lock protocol error "))
    44     (tr (td (tt "empty")) (td "(Internal Only) Database table is empty "))
    45     (tr (td (tt "schema")) (td "The database schema changed "))
    46     (tr (td (tt "too-big")) (td "Too much data for one row of a table "))
    47     (tr (td (tt "constraint")) (td "Abort due to contraint violation "))
    48     (tr (td (tt "mismatch")) (td "Data type mismatch "))
    49     (tr (td (tt "misuse")) (td "Library used incorrectly "))
    50     (tr (td (tt "no-lfs")) (td "Uses OS features not supported on host "))
    51     (tr (td (tt "authorization")) (td " Authorization denied"))
    52     #;(tr (td (tt "row")) (td (tt "step!") " has another row ready "))
    53     (tr (td (tt "done")) (td (tt "step!") " has finished executing, so no further data is ready")))))
     25        (p "Unless otherwise indicated, all procedures and methods in this egg may throw an exception of the kind " (tt "(exn sqlite3)") " if something goes wrong. This exception will contain a " (tt "status") " property indicating the return value of the operation that failed:"
     26        (table
     27          (tr (th "Symbol") (th "Meaning"))
     28          #;(tr (td (tt "ok")) (td "Successful result"))
     29          (tr (td (tt "error")) (td "SQL error or missing database "))
     30          (tr (td (tt "internal")) (td "An internal logic error in SQLite "))
     31          (tr (td (tt "permission")) (td "Access permission denied "))
     32          (tr (td (tt "abort")) (td "Callback routine requested an abort "))
     33          (tr (td (tt "busy")) (td "The database file is locked "))
     34          (tr (td (tt "locked")) (td "A table in the database is locked "))
     35          (tr (td (tt "no-memory")) (td "A malloc() failed "))
     36          (tr (td (tt "read-only")) (td "Attempt to write a readonly database "))
     37          (tr (td (tt "interrupt")) (td "Operation terminated by sqlite-interrupt() "))
     38          (tr (td (tt "io-error")) (td "Some kind of disk I/O error occurred "))
     39          (tr (td (tt "corrupt")) (td "The database disk image is malformed "))
     40          (tr (td (tt "not-found")) (td "(Internal Only) Table or record not found "))
     41          (tr (td (tt "full")) (td "Insertion failed because database is full "))
     42          (tr (td (tt "cant-open")) (td "Unable to open the database file "))
     43          (tr (td (tt "protocol")) (td "Database lock protocol error "))
     44          (tr (td (tt "empty")) (td "(Internal Only) Database table is empty "))
     45          (tr (td (tt "schema")) (td "The database schema changed "))
     46          (tr (td (tt "too-big")) (td "Too much data for one row of a table "))
     47          (tr (td (tt "constraint")) (td "Abort due to contraint violation "))
     48          (tr (td (tt "mismatch")) (td "Data type mismatch "))
     49          (tr (td (tt "misuse")) (td "Library used incorrectly "))
     50          (tr (td (tt "no-lfs")) (td "Uses OS features not supported on host "))
     51          (tr (td (tt "authorization")) (td " Authorization denied"))
     52          #;(tr (td (tt "row")) (td (tt "step!") " has another row ready "))
     53          (tr (td (tt "done")) (td (tt "step!") " has finished executing, so no further data is ready")))))
    5454
    5555      (subsection "Abstract data types"
    5656
    57   (procedure ("(database? OBJECT) " (& "rArr") " BOOLEAN")
    58     (p "Checks whether a value represents an SQLite database."))
    59   (procedure ("(error-database LOCATION OBJECT [ARGUMENT-NAME]) " (& "rArr") " VOID")
    60     (p "Raises a type error saying that a database was expected instead "
    61        "of the given value."))
    62   (procedure ("(check-database LOCATION OBJECT [ARGUMENT-NAME]) " (& "rArr") " VOID")
    63     (p "Raises a type error like " (tt "error-database") " does, unless "
    64        "the given value satisfies " (tt "database?")))
    65 
    66   (procedure ("(statement? OBJECT) " (& "rArr") " BOOLEAN")
    67     (p "Checks whether the value " (tt "v") " represents an SQL statement."))
    68   (procedure ("(error-statement LOCATION OBJECT [ARGUMENT-NAME]) " (& "rArr") " VOID")
    69     (p "Raises a type error saying that a statement was expected instead of the given value."))
    70   (procedure ("(check-statement LOCATION OBJECT [ARGUMENT-NAME]) " (& "rArr") " VOID")
    71     (p "Raises a type error like " (tt "error-statement") " does, unless the given value satisfies " (tt "statement?"))))
     57        (procedure ("(database? OBJECT) " (& "rArr") " BOOLEAN")
     58          (p "Checks whether a value represents an SQLite database."))
     59        (procedure ("(error-database LOCATION OBJECT [ARGUMENT-NAME]) " (& "rArr") " VOID")
     60          (p "Raises a type error saying that a database was expected instead "
     61             "of the given value."))
     62        (procedure ("(check-database LOCATION OBJECT [ARGUMENT-NAME]) " (& "rArr") " VOID")
     63          (p "Raises a type error like " (tt "error-database") " does, unless "
     64             "the given value satisfies " (tt "database?")))
     65
     66        (procedure ("(statement? OBJECT) " (& "rArr") " BOOLEAN")
     67          (p "Checks whether the value " (tt "v") " represents an SQL statement."))
     68        (procedure ("(error-statement LOCATION OBJECT [ARGUMENT-NAME]) " (& "rArr") " VOID")
     69          (p "Raises a type error saying that a statement was expected instead of the given value."))
     70        (procedure ("(check-statement LOCATION OBJECT [ARGUMENT-NAME]) " (& "rArr") " VOID")
     71          (p "Raises a type error like " (tt "error-statement") " does, unless the given value satisfies " (tt "statement?"))))
    7272
    7373      (subsection "Managing databases"
    7474
    75   (procedure ("(open-database PATH) " (& "rArr") " DATABASE")
    76     (p "Opens the indicated database file and returns a database object for it.")
    77     (p "The given path is subject to the same special expansion as paths passed to " (tt "open-input-file") " and similar procedures."))
    78 
    79   (procedure ("(define-collation DATABASE NAME [PROC]) " (& "rArr") " VOID")
    80     (p "If a procedure is given, registers a new collation sequence identified by " (tt "name") " for use in the context of database handle " (tt "db") ". If no procedure is passed, the collation sequence with the given name is removed.")
    81     (p (tt "PROC") " should have the signature " (tt "(PROC STRING STRING) " (& "rArr") " FIXNUM") ". It should return a negative number if the first argument sorts before the second, a positive number if the second sorts before the first and zero if they are equal.")
    82     (p "As " (tt "PROC") " will be called in a callback context from within " (tt "step!") ", safety measures are installed to avoid throwing any exceptions, invoking continuations or returning invalid values from it. Attempts to do so will result in a " (tt "0") " return value and warning messages."))
    83 
    84   (definition
    85     (signatures
    86       (signature "procedure" ("(define-function DATABASE NAME N PROC) " (& "rArr") " VOID"))
    87       (signature "procedure" ("(define-function DATABASE NAME N STEP-PROC SEED [FINAL-PROC]) " (& "rArr") " VOID")))
    88     (p "Registers a new SQL function identified by " (tt "NAME") " for use in the context of the given database handle. If " (tt "STEP-PROC") " and " (tt "SEED") " are given, the new function becomes an aggregate function. Once registered, functions cannot be deleted.")
    89     (p (tt "N") " is the number of parameters the new SQL function takes or " (tt "-1") " to allow any number of arguments.")
    90     (p (tt "PROC") " should have the signature " (tt "(PROC . PARAMS) " (& "rArr") " OBJECT") ". It is called with the " (tt "N") " parameters given to the SQL function converted into Scheme objects like by " (tt "column-data") ". The return value is converted into an SQLite data object like by " (tt "bind!") ". A return value of " (tt "(void)") " corresponds to " (tt "NULL") " in SQLite.")
    91     (p (tt "STEP-PROC") " should have the signature " (tt "(STEP-PROC SEED . PARAMS) " (& "rArr") " SEED") ". It is called with the parameters given to the SQL function for every row being processed. The seed value passed is initially the one given as an argument to " (tt "define-function") "; for subsequent calls it is the last value returned by " (tt "STEP-PROC") " and after completion of " (tt "FINAL-PROC") " it will be the initial value again.")
    92     (p (tt "FINAL-PROC") " should have the signature " (tt "(FINAL-PROC SEED) " (& "rArr") " OBJECT") " and transforms the last seed value into the value to be returned from the aggregate function. If it is not explicitly specified, " (tt "STEP-PROC") " defaults to the identity function.")
    93     (p "As " (tt "PROC") ", " (tt "STEP-PROC") " and " (tt "FINAL-PROC") " will be called in a callback context from within " (tt "step!") ", safety measures are installed to avoid throwing any exceptions, invoking continuations or returning invalid values from them. Attempts to do such things will result in " (tt "NULL") " return values and warning messages."))
    94 
    95   (procedure ("(set-busy-handler! DATABASE PROC) " (& "rArr") " VOID")
    96     (p "Installs the supplied procedure as the application's busy handler, or removes it if " (tt "#f") ".  When the database returns a busy error code, the egg will invoke this handler repeatedly until it returns " (tt "#f") ".  The handler will be called with arguments " (tt "DATABASE") " and " (tt "COUNT") " (number of times invoked for the same operation).")
    97     (p "As " (tt "PROC") " is not called in a callback context, it is legal to invoke captured continuations, and it is safe in the presence of multiple threads.  In general, this handler should give up at some point to avoid possible deadlock.")
    98     (p "For an example handler, see the code of " (tt "make-busy-timeout") "."))
    99   (procedure ("(make-busy-timeout MS) " (& "rArr") " PROC")
    100     (p "Returns a handler suitable for use with " (tt "set-busy-handler!") ". It polls in increasing intervals until the timeout in milliseconds is reached. The handler is non-blocking.")
    101     (pre ";; Example:
     75        (procedure ("(open-database PATH) " (& "rArr") " DATABASE")
     76          (p "Opens the indicated database file and returns a database object for it.")
     77          (p "The given path is subject to the same special expansion as paths passed to " (tt "open-input-file") " and similar procedures."))
     78
     79        (procedure ("(define-collation DATABASE NAME [PROC]) " (& "rArr") " VOID")
     80          (p "If a procedure is given, registers a new collation sequence identified by " (tt "name") " for use in the context of database handle " (tt "db") ". If no procedure is passed, the collation sequence with the given name is removed.")
     81          (p (tt "PROC") " should have the signature " (tt "(PROC STRING STRING) " (& "rArr") " FIXNUM") ". It should return a negative number if the first argument sorts before the second, a positive number if the second sorts before the first and zero if they are equal.")
     82          (p "As " (tt "PROC") " will be called in a callback context from within " (tt "step!") ", safety measures are installed to avoid throwing any exceptions, invoking continuations or returning invalid values from it. Attempts to do so will result in a " (tt "0") " return value and warning messages."))
     83
     84        (definition
     85          (signatures
     86            (signature "procedure" ("(define-function DATABASE NAME N PROC) " (& "rArr") " VOID"))
     87            (signature "procedure" ("(define-function DATABASE NAME N STEP-PROC SEED [FINAL-PROC]) " (& "rArr") " VOID")))
     88          (p "Registers a new SQL function identified by " (tt "NAME") " for use in the context of the given database handle. If " (tt "STEP-PROC") " and " (tt "SEED") " are given, the new function becomes an aggregate function. Once registered, functions cannot be deleted.")
     89          (p (tt "N") " is the number of parameters the new SQL function takes or " (tt "-1") " to allow any number of arguments.")
     90          (p (tt "PROC") " should have the signature " (tt "(PROC . PARAMS) " (& "rArr") " OBJECT") ". It is called with the " (tt "N") " parameters given to the SQL function converted into Scheme objects like by " (tt "column-data") ". The return value is converted into an SQLite data object like by " (tt "bind!") ". A return value satisfying " (tt "sql-null?") " corresponds to " (tt "NULL") " in SQLite.")
     91          (p (tt "STEP-PROC") " should have the signature " (tt "(STEP-PROC SEED . PARAMS) " (& "rArr") " SEED") ". It is called with the parameters given to the SQL function for every row being processed. The seed value passed is initially the one given as an argument to " (tt "define-function") "; for subsequent calls it is the last value returned by " (tt "STEP-PROC") " and after completion of " (tt "FINAL-PROC") " it will be the initial value again.")
     92          (p (tt "FINAL-PROC") " should have the signature " (tt "(FINAL-PROC SEED) " (& "rArr") " OBJECT") " and transforms the last seed value into the value to be returned from the aggregate function. If it is not explicitly specified, " (tt "STEP-PROC") " defaults to the identity function.")
     93          (p "As " (tt "PROC") ", " (tt "STEP-PROC") " and " (tt "FINAL-PROC") " will be called in a callback context from within " (tt "step!") ", safety measures are installed to avoid throwing any exceptions, invoking continuations or returning invalid values from them. Attempts to do such things will result in " (tt "NULL") " return values and warning messages."))
     94
     95        (procedure ("(set-busy-handler! DATABASE PROC) " (& "rArr") " VOID")
     96          (p "Installs the supplied procedure as the application's busy handler, or removes it if " (tt "#f") ".  When the database returns a busy error code, the egg will invoke this handler repeatedly until it returns " (tt "#f") ".  The handler will be called with arguments " (tt "DATABASE") " and " (tt "COUNT") " (number of times invoked for the same operation).")
     97          (p "As " (tt "PROC") " is not called in a callback context, it is legal to invoke captured continuations, and it is safe in the presence of multiple threads.  In general, this handler should give up at some point to avoid possible deadlock.")
     98          (p "For an example handler, see the code of " (tt "make-busy-timeout") "."))
     99        (procedure ("(make-busy-timeout MS) " (& "rArr") " PROC")
     100          (p "Returns a handler suitable for use with " (tt "set-busy-handler!") ". It polls in increasing intervals until the timeout in milliseconds is reached. The handler is non-blocking.")
     101          (pre ";; Example:
    102102(define open-database/timeout
    103103  (let ((handler (make-busy-timeout 2000)))
     
    107107  db))))"))
    108108
    109   (procedure ("(interrupt! DATABASE) " (& "rArr") " VOID")
    110     (p "Cancels any running database operation as soon as possible.")
    111     (p "This function is always successful and never throws an exception."))
    112 
    113   (procedure ("(auto-committing? DATABASE) " (& "rArr") " BOOLEAN")
    114     (p "Checks whether the database is currently in auto committing mode, i.e. no transaction is currently active.")
    115     (p "This function always returns a state and never throws an exception."))
    116 
    117   (procedure ("(change-count DATABASE [TOTAL]) " (& "rArr") " CARDINAL-INTEGER")
    118     (p "Returns the number of rows changed by the last statement (if " (tt "(not TOTAL)") ", which is the default) or since the database was opened (if " (tt "TOTAL") ").")
    119     (p "This function always returns a count and never throws an exception."))
    120 
    121   (procedure ("(last-insert-rowid DATABASE) " (& "rArr") " INTEGER")
    122     (p "Returns the row ID of the last row inserted in " (tt "db") ".")
    123     (p "This function always returns a number and never throws an exception."))
    124 
    125   (procedure ("(finalize! DATABASE-OR-STATEMENT) " (& "rArr") " VOID")
    126     (p "Closes the given database or finalizes the given statement.")
    127     (p "Every statement must be finalized to free its resources and discard it before the database itself can be finalized.")))
     109        (procedure ("(interrupt! DATABASE) " (& "rArr") " VOID")
     110          (p "Cancels any running database operation as soon as possible.")
     111          (p "This function is always successful and never throws an exception."))
     112
     113        (procedure ("(auto-committing? DATABASE) " (& "rArr") " BOOLEAN")
     114          (p "Checks whether the database is currently in auto committing mode, i.e. no transaction is currently active.")
     115          (p "This function always returns a state and never throws an exception."))
     116
     117        (procedure ("(change-count DATABASE [TOTAL]) " (& "rArr") " CARDINAL-INTEGER")
     118          (p "Returns the number of rows changed by the last statement (if " (tt "(not TOTAL)") ", which is the default) or since the database was opened (if " (tt "TOTAL") ").")
     119          (p "This function always returns a count and never throws an exception."))
     120
     121        (procedure ("(last-insert-rowid DATABASE) " (& "rArr") " INTEGER")
     122          (p "Returns the row ID of the last row inserted in " (tt "db") ".")
     123          (p "This function always returns a number and never throws an exception."))
     124
     125        (procedure ("(finalize! DATABASE-OR-STATEMENT) " (& "rArr") " VOID")
     126          (p "Closes the given database or finalizes the given statement.")
     127          (p "Every statement must be finalized to free its resources and discard it before the database itself can be finalized.")))
    128128
    129129      (subsection "Managing statements"
    130130
    131   (procedure ("(prepare DATABASE SQL) " (& "rArr") " STATEMENT, SQL")
    132     (p "Compiles the first SQL statement in " (tt "SQL") " and returns a statement and the tail of the SQL code, which was not compiled (or an empty string)."))
    133 
    134   (procedure ("(repair! STATEMENT) " (& "rArr") " VOID")
    135     (p "Recompiles the SQL code used to create the statement, transfers all existing bindings from the old statement handle to the new one and destructively modifies " (tt "STATEMENT") " to point to the new statement handle.")
    136     (p "If the operation is successful, the old handle is finalized, in case of error, the new handle is finalized and the old one stays untouched.")
    137     (p "Usually you should not have to call this routine by hand. It is invoked by " (tt "step!") " to automagically repair a stale statement handle after a database schema change."))
    138 
    139   (procedure ("(column-count STATEMENT) " (& "rArr") " CARDINAL-INTEGER")
    140     (p "Can be applied to any statement and returns the number of columns it will return as results.")
    141     (p "This procedure always succeeds and never throws an exception."))
    142 
    143   (procedure ("(column-name STATEMENT I) " (& "rArr") " STRING")
    144     (p "Can be applied to any statement and returns the name of the column number " (tt "I") " (counting from 0) as a string or " (tt "#f") " if the column has no name.")
    145     (p "This procedure always succeeds and never throws an exception."))
    146 
    147   (procedure ("(column-declared-type STATEMENT I) " (& "rArr") " STRING")
    148     (p "Can be applied to any statement and returns the declared type (as given in the " (tt "CREATE") " statement) of the column number " (tt "I") " (counting from 0) as a string or " (tt "#f") " if the column has no declared type.")
    149     (p "This procedure always succeeds and never throws an exception."))
    150 
    151   (procedure ("(bind-parameter-count STATEMENT) " (& "rArr") " CARDINAL-INTEGER")
    152     (p "Can be applied to any statement and returns the number of free parameters that can be bound in the statement.")
    153     (p "This procedure always succeeds and never throws an exception."))
    154 
    155   (procedure ("(bind-parameter-index STATEMENT NAME) " (& "rArr") " CARDINAL-INTEGER")
    156     (p "Can be applied to any statement and returns the index of the bindable parameter called " (tt "NAME") " or " (tt "#f") " if no such parameter exists.")
    157     (p "This procedure always succeeds and never throws an exception."))
    158 
    159   (procedure ("(bind-parameter-name STATEMENT I) " (& "rArr") " STRING")
    160     (p "Can be applied to any statement and returns the name of the bindable parameter number " (tt "I") " (counting from 0) or " (tt "#f") " if no such parameter exists or the parameter has no name.")
    161     (p "This procedure always succeeds and never throws an exception."))
    162 
    163   (procedure ("(bind! STATEMENT I OBJECT) " (& "rArr") " VOID")
    164     (p "Can be applied to any statement to bind its free parameter number " (tt "I") " (counting from 0) to the given value. Scheme types of the value map to SQLite types as follows:"
    165     (table
    166       (tr (th "Scheme type") (th "SQLite type"))
    167       (tr (td (tt "boolean?")) (td (tt "integer: #t = 1, #f = 0")))
    168       (tr (td (tt "fixnum?")) (td (tt "integer")))
    169       (tr (td (tt "real?")) (td (tt "float")))
    170       (tr (td (tt "string?")) (td (tt "text")))
    171       (tr (td (tt "blob?")) (td (tt "blob")))
    172       (tr (td (tt "(void)")) (td (tt "null")))))
    173     (p "Unless there is internal trouble in SQLite, this method should always succeeds and never throw an exception. For invalid parameter indices the method just silently does nothing."))
    174 
    175   (procedure ("(bind-parameters! STATEMENT . PARAMETERS) " (& "rArr") " VOID")
    176     (p "Resets the statement and binds all its free parameters.")
    177     (p "In addition to just listing the values to bind to the statement's parameters in sequence, you may specify parameters prefixed by keywords that are resolved to parameter indices by prefixing their names with " (tt "\":\"") " and resolving them using " (tt "bind-parameter-index") "."))
    178 
    179   (procedure ("(step! STATEMENT) " (& "rArr") " BOOLEAN")
    180     (p "Single-steps the execution of " (tt "STATEMENT") " and returns " (tt "#t") " if a result row was produced, " (tt "#f") " if no further results are available as the statement has been stepped through. This procedure must be called at least once before any results can be retrieved from the statement."))
    181 
    182   (procedure ("(column-type STATEMENT I) " (& "rArr") " SYMBOL")
    183     (p "Can be applied to a statement that has just been stepped (otherwise it returns " (tt "#f") ") and returns the SQLite type of the result column number " (tt "I") " (counting from 0) as a symbol.")
    184     (p "The return value can be one of the symbols " (tt "null") ", " (tt "integer") ", " (tt "float") ", " (tt "text") " or " (tt "blob") ".")
    185     (p "This procedure always succeeds and never throws an exception."))
    186 
    187   (procedure ("(column-data STATEMENT I) " (& "rArr") " OBJECT")
    188     (p "Can be applied to a statement that has just been stepped. Consults " (tt "column-type") " and " (tt "column-declared-type") " to determine the type of the indicated column and to return its data as an appropriate Scheme object:"
    189     (table
    190       (tr (th "SQLite type") (th "Scheme type"))
    191       (tr (td (tt "integer") ", declared " (tt "\"bool\"")) (td (tt "boolean?")))
    192       (tr (td (tt "integer")) (td (tt "integer?")))
    193       (tr (td (tt "float")) (td (tt "real?")))
    194       (tr (td (tt "text")) (td (tt "string?")))
    195       (tr (td (tt "blob")) (td (tt "blob?")))
    196       (tr (td (tt "null")) (td (tt "(void)")))))
    197     (p "The declared type of a column is considered to be boolean if the type declaration contains the character sequence \"bool\" anywhere, ignoring case.")
    198     (p "This procedure always succeeds and never throws an exception."))
    199 
    200   (procedure ("(reset! STATEMENT) " (& "rArr") " VOID")
    201     (p "Can be applied to any statement and resets it such that execution using " (tt "step!") " will perform all operations of the statement again.")))
     131        (procedure ("(prepare DATABASE SQL) " (& "rArr") " STATEMENT, SQL")
     132          (p "Compiles the first SQL statement in " (tt "SQL") " and returns a statement and the tail of the SQL code, which was not compiled (or an empty string)."))
     133
     134        (procedure ("(repair! STATEMENT) " (& "rArr") " VOID")
     135          (p "Recompiles the SQL code used to create the statement, transfers all existing bindings from the old statement handle to the new one and destructively modifies " (tt "STATEMENT") " to point to the new statement handle.")
     136          (p "If the operation is successful, the old handle is finalized, in case of error, the new handle is finalized and the old one stays untouched.")
     137          (p "Usually you should not have to call this routine by hand. It is invoked by " (tt "step!") " to automagically repair a stale statement handle after a database schema change."))
     138
     139        (procedure ("(column-count STATEMENT) " (& "rArr") " CARDINAL-INTEGER")
     140          (p "Can be applied to any statement and returns the number of columns it will return as results.")
     141          (p "This procedure always succeeds and never throws an exception."))
     142
     143        (procedure ("(column-name STATEMENT I) " (& "rArr") " STRING")
     144          (p "Can be applied to any statement and returns the name of the column number " (tt "I") " (counting from 0) as a string or " (tt "#f") " if the column has no name.")
     145          (p "This procedure always succeeds and never throws an exception."))
     146
     147        (procedure ("(column-declared-type STATEMENT I) " (& "rArr") " STRING")
     148          (p "Can be applied to any statement and returns the declared type (as given in the " (tt "CREATE") " statement) of the column number " (tt "I") " (counting from 0) as a string or " (tt "#f") " if the column has no declared type.")
     149          (p "This procedure always succeeds and never throws an exception."))
     150
     151        (procedure ("(bind-parameter-count STATEMENT) " (& "rArr") " CARDINAL-INTEGER")
     152          (p "Can be applied to any statement and returns the number of free parameters that can be bound in the statement.")
     153          (p "This procedure always succeeds and never throws an exception."))
     154
     155        (procedure ("(bind-parameter-index STATEMENT NAME) " (& "rArr") " CARDINAL-INTEGER")
     156          (p "Can be applied to any statement and returns the index of the bindable parameter called " (tt "NAME") " or " (tt "#f") " if no such parameter exists.")
     157          (p "This procedure always succeeds and never throws an exception."))
     158
     159        (procedure ("(bind-parameter-name STATEMENT I) " (& "rArr") " STRING")
     160          (p "Can be applied to any statement and returns the name of the bindable parameter number " (tt "I") " (counting from 0) or " (tt "#f") " if no such parameter exists or the parameter has no name.")
     161          (p "This procedure always succeeds and never throws an exception."))
     162
     163        (procedure ("(bind! STATEMENT I OBJECT) " (& "rArr") " VOID")
     164          (p "Can be applied to any statement to bind its free parameter number " (tt "I") " (counting from 0) to the given value. Scheme types of the value map to SQLite types as follows:"
     165          (table
     166            (tr (th "Scheme type") (th "SQLite type"))
     167            (tr (td (tt "boolean?")) (td (tt "integer: #t = 1, #f = 0")))
     168            (tr (td (tt "fixnum?")) (td (tt "integer")))
     169            (tr (td (tt "real?")) (td (tt "float")))
     170            (tr (td (tt "string?")) (td (tt "text")))
     171            (tr (td (tt "blob?")) (td (tt "blob")))
     172            (tr (td (tt "sql-null?")) (td (tt "null")))))
     173          (p "Unless there is internal trouble in SQLite, this method should always succeeds and never throw an exception. For invalid parameter indices the method just silently does nothing."))
     174
     175        (procedure ("(bind-parameters! STATEMENT . PARAMETERS) " (& "rArr") " VOID")
     176          (p "Resets the statement and binds all its free parameters.")
     177          (p "In addition to just listing the values to bind to the statement's parameters in sequence, you may specify parameters prefixed by keywords that are resolved to parameter indices by prefixing their names with " (tt "\":\"") " and resolving them using " (tt "bind-parameter-index") "."))
     178
     179        (procedure ("(step! STATEMENT) " (& "rArr") " BOOLEAN")
     180          (p "Single-steps the execution of " (tt "STATEMENT") " and returns " (tt "#t") " if a result row was produced, " (tt "#f") " if no further results are available as the statement has been stepped through. This procedure must be called at least once before any results can be retrieved from the statement."))
     181
     182        (procedure ("(column-type STATEMENT I) " (& "rArr") " SYMBOL")
     183          (p "Can be applied to a statement that has just been stepped (otherwise it returns " (tt "#f") ") and returns the SQLite type of the result column number " (tt "I") " (counting from 0) as a symbol.")
     184          (p "The return value can be one of the symbols " (tt "null") ", " (tt "integer") ", " (tt "float") ", " (tt "text") " or " (tt "blob") ".")
     185          (p "This procedure always succeeds and never throws an exception."))
     186
     187        (procedure ("(column-data STATEMENT I) " (& "rArr") " OBJECT")
     188          (p "Can be applied to a statement that has just been stepped. Consults " (tt "column-type") " and " (tt "column-declared-type") " to determine the type of the indicated column and to return its data as an appropriate Scheme object:"
     189          (table
     190            (tr (th "SQLite type") (th "Scheme type"))
     191            (tr (td (tt "integer") ", declared " (tt "\"bool\"")) (td (tt "boolean?")))
     192            (tr (td (tt "integer")) (td (tt "integer?")))
     193            (tr (td (tt "float")) (td (tt "real?")))
     194            (tr (td (tt "text")) (td (tt "string?")))
     195            (tr (td (tt "blob")) (td (tt "blob?")))
     196            (tr (td (tt "null")) (td (tt "sql-null?")))))
     197          (p "The declared type of a column is considered to be boolean if the type declaration contains the character sequence \"bool\" anywhere, ignoring case.")
     198          (p "This procedure always succeeds and never throws an exception."))
     199
     200        (procedure ("(reset! STATEMENT) " (& "rArr") " VOID")
     201          (p "Can be applied to any statement and resets it such that execution using " (tt "step!") " will perform all operations of the statement again.")))
    202202
    203203      (subsection "Simple statement interface"
    204204
    205   (procedure ("(call-with-temporary-statements PROC DATABASE . SQLS) " (& "rArr") " OBJECT")
    206     (p "Compiles the SQL sources into statements in the context of " (tt "DATABASE") ", applies " (tt "PROC") " to these statements and returns " (tt "PROC") "'s result. The statements are created and finalized in " (tt "dynamic-wind") " entry and exit blocks around the application of " (tt "PROC") "."))
    207 
    208   (definition
    209     (signatures
    210       (signature "procedure" ("(execute STATEMENT . PARAMETERS) " (& "rArr") " VOID"))
    211       (signature "procedure" ("(execute DATABASE SQL . PARAMETERS) " (& "rArr") " VOID")))
    212     (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and executes the statement ignoring possible results from it."))
    213 
    214   (definition
    215     (signatures
    216       (signature "procedure" ("(update STATEMENT . PARAMETERS) " (& "rArr") " CARDINAL-INTEGER"))
    217       (signature "procedure" ("(update DATABASE SQL . PARAMETERS) " (& "rArr") " CARDINAL-INTEGER")))
    218     (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and executes the specified statement ignoring possible results from it, returning the result of applying " (tt "change-count") " to the affected database after the execution of the statement instead."))
    219 
    220   (definition
    221     (signatures
    222       (signature "procedure" ("(first-result STATEMENT . PARAMETERS) " (& "rArr") " OBJECT"))
    223       (signature "procedure" ("(first-result DATABASE SQL . PARAMETERS) " (& "rArr") " OBJECT")))
    224     (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and single-steps the statement once returning the value of the first column in the first result row. Resets the statement again just before returning.")
    225     (p "If the given statement does not yield any results, an " (tt "(exn sqlite3)") " is thrown with the " (tt "status") "-property set to " (tt "done") "."))
    226 
    227   (definition
    228     (signatures
    229       (signature "procedure" ("(first-row STATEMENT . PARAMETERS) " (& "rArr") " LIST"))
    230       (signature "procedure" ("(first-row DATABASE SQL . PARAMETERS) " (& "rArr") " LIST")))
    231     (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and single-steps the statement once returning all columns in the first result row as a list.")
    232     (p "If the given statement does not yield any results, an " (tt "(exn sqlite3)") " is thrown with the " (tt "status") "-property set to " (tt "done") "."))
    233 
    234   (definition
    235     (signatures
    236       (signature "procedure" ("(fold-row PROC INIT STATEMENT . PARAMETERS) " (& "rArr") " OBJECT"))
    237       (signature "procedure" ("(fold-row PROC INIT DATABASE SQL . PARAMETERS) " (& "rArr") " OBJECT")))
    238     (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and executes it step by step. After each step, the column values of the current result row are retrieved and " (tt "PROC") " is applied to the current folded value, set to " (tt "INIT") " in the first step, and the column values. The result of the application becomes the new folded value."))
    239 
    240   (definition
    241     (signatures
    242       (signature "procedure" ("(for-each-row PROC STATEMENT . PARAMETERS) " (& "rArr") " VOID"))
    243       (signature "procedure" ("(for-each-row PROC DATABASE SQL . PARAMETERS) " (& "rArr") " VOID")))
    244     (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and executes it step by step. After each step, the column values of the current result row are retrieved and " (tt "PROC") " is applied to them. The results of this application are discarded."))
    245 
    246   (definition
    247     (signatures
    248       (signature "procedure" ("(map-row PROC STATEMENT . PARAMETERS) " (& "rArr") " LIST"))
    249       (signature "procedure" ("(map-row PROC DATABASE SQL . PARAMETERS) " (& "rArr") " LIST")))
    250     (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and executes it step by step. After each step, the column values of the current result row are retrieved and " (tt "PROC") " is applied to them. The results of these applications are collected into a list."))
     205        (procedure ("(call-with-temporary-statements PROC DATABASE . SQLS) " (& "rArr") " OBJECT")
     206          (p "Compiles the SQL sources into statements in the context of " (tt "DATABASE") ", applies " (tt "PROC") " to these statements and returns " (tt "PROC") "'s result. The statements are created and finalized in " (tt "dynamic-wind") " entry and exit blocks around the application of " (tt "PROC") "."))
     207
     208        (definition
     209          (signatures
     210            (signature "procedure" ("(execute STATEMENT . PARAMETERS) " (& "rArr") " VOID"))
     211            (signature "procedure" ("(execute DATABASE SQL . PARAMETERS) " (& "rArr") " VOID")))
     212          (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and executes the statement ignoring possible results from it."))
     213
     214        (definition
     215          (signatures
     216            (signature "procedure" ("(update STATEMENT . PARAMETERS) " (& "rArr") " CARDINAL-INTEGER"))
     217            (signature "procedure" ("(update DATABASE SQL . PARAMETERS) " (& "rArr") " CARDINAL-INTEGER")))
     218          (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and executes the specified statement ignoring possible results from it, returning the result of applying " (tt "change-count") " to the affected database after the execution of the statement instead."))
     219
     220        (definition
     221          (signatures
     222            (signature "procedure" ("(first-result STATEMENT . PARAMETERS) " (& "rArr") " OBJECT"))
     223            (signature "procedure" ("(first-result DATABASE SQL . PARAMETERS) " (& "rArr") " OBJECT")))
     224          (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and single-steps the statement once returning the value of the first column in the first result row. Resets the statement again just before returning.")
     225          (p "If the given statement does not yield any results, an " (tt "(exn sqlite3)") " is thrown with the " (tt "status") "-property set to " (tt "done") "."))
     226
     227        (definition
     228          (signatures
     229            (signature "procedure" ("(first-row STATEMENT . PARAMETERS) " (& "rArr") " LIST"))
     230            (signature "procedure" ("(first-row DATABASE SQL . PARAMETERS) " (& "rArr") " LIST")))
     231          (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and single-steps the statement once returning all columns in the first result row as a list.")
     232          (p "If the given statement does not yield any results, an " (tt "(exn sqlite3)") " is thrown with the " (tt "status") "-property set to " (tt "done") "."))
     233
     234        (definition
     235          (signatures
     236            (signature "procedure" ("(fold-row PROC INIT STATEMENT . PARAMETERS) " (& "rArr") " OBJECT"))
     237            (signature "procedure" ("(fold-row PROC INIT DATABASE SQL . PARAMETERS) " (& "rArr") " OBJECT")))
     238          (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and executes it step by step. After each step, the column values of the current result row are retrieved and " (tt "PROC") " is applied to the current folded value, set to " (tt "INIT") " in the first step, and the column values. The result of the application becomes the new folded value."))
     239
     240        (definition
     241          (signatures
     242            (signature "procedure" ("(for-each-row PROC STATEMENT . PARAMETERS) " (& "rArr") " VOID"))
     243            (signature "procedure" ("(for-each-row PROC DATABASE SQL . PARAMETERS) " (& "rArr") " VOID")))
     244          (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and executes it step by step. After each step, the column values of the current result row are retrieved and " (tt "PROC") " is applied to them. The results of this application are discarded."))
     245
     246        (definition
     247          (signatures
     248            (signature "procedure" ("(map-row PROC STATEMENT . PARAMETERS) " (& "rArr") " LIST"))
     249            (signature "procedure" ("(map-row PROC DATABASE SQL . PARAMETERS) " (& "rArr") " LIST")))
     250          (p "(Compiles the given SQL), resets the statement, binds the statement's free parameters and executes it step by step. After each step, the column values of the current result row are retrieved and " (tt "PROC") " is applied to them. The results of these applications are collected into a list."))
    251251
    252252      (subsection "Utility functions"
    253253
    254   (procedure ("(with-transaction DATABASE THUNK [TYPE]) " (& "rArr") " OBJECT")
    255     (p "Runs " (tt "THUNK") " within the scope of a transaction on the database and returns the return value from " (tt "THUNK") ".")
    256     (p "The transaction is committed upon exit from " (tt "THUNK") " if " (tt "THUNK") " returns a true value. If " (tt "THUNK") " returns a false value or throws an exception, the transaction is rolled back.")
    257     (p "The " (tt "TYPE") " of the transaction can be specified as one of the symbols " (tt "deferred") "(the default), " (tt "immediate") " or " (tt "exclusive") "."))
    258 
    259   (procedure ("(sql-complete? SQL) " (& "rArr") " BOOLEAN")
    260     (p "Checks whether " (tt "SQL") " comprises at least one complete SQL statement."))
    261 
    262   (procedure ("(enable-shared-cache! BOOLEAN) " (& "rArr") " VOID")
    263     (p "Enables (or disables) the sharing of the database cache and schema data structures between connections to the same database."))
    264 
    265   (procedure ("(database-version) " (& "rArr") " STRING")
    266     (p "Returns a string identifying the version of SQLite in use.")))))
     254        (procedure ("(with-transaction DATABASE THUNK [TYPE]) " (& "rArr") " OBJECT")
     255          (p "Runs " (tt "THUNK") " within the scope of a transaction on the database and returns the return value from " (tt "THUNK") ".")
     256          (p "The transaction is committed upon exit from " (tt "THUNK") " if " (tt "THUNK") " returns a true value. If " (tt "THUNK") " returns a false value or throws an exception, the transaction is rolled back.")
     257          (p "The " (tt "TYPE") " of the transaction can be specified as one of the symbols " (tt "deferred") "(the default), " (tt "immediate") " or " (tt "exclusive") "."))
     258
     259        (procedure ("(sql-complete? SQL) " (& "rArr") " BOOLEAN")
     260          (p "Checks whether " (tt "SQL") " comprises at least one complete SQL statement."))
     261
     262        (procedure ("(enable-shared-cache! BOOLEAN) " (& "rArr") " VOID")
     263          (p "Enables (or disables) the sharing of the database cache and schema data structures between connections to the same database."))
     264
     265        (procedure ("(database-version) " (& "rArr") " STRING")
     266          (p "Returns a string identifying the version of SQLite in use.")))))
    267267
    268268    (history
     269      (version "3.3.0" "Switched to using " (tt "(sql-null)") " for " (tt "NULL") " values")
    269270      (version "3.2.1" "Added a test suite")
    270271      (version "3.2.0" "Removed the unsafe busy handler and timeout APIs, since a safe API exists")
  • release/4/sqlite3/trunk/sqlite3.html

    r15334 r15344  
    164164<li>synch</li>
    165165<li>miscmacros</li>
    166 <li>matchable</li></ul></div>
     166<li>matchable</li>
     167<li>sql-null</li></ul></div>
    167168<div class="section">
    168169<h3>Documentation</h3>
     
    284285<p>Registers a new SQL function identified by <tt>NAME</tt> for use in the context of the given database handle. If <tt>STEP-PROC</tt> and <tt>SEED</tt> are given, the new function becomes an aggregate function. Once registered, functions cannot be deleted.</p>
    285286<p><tt>N</tt> is the number of parameters the new SQL function takes or <tt>-1</tt> to allow any number of arguments.</p>
    286 <p><tt>PROC</tt> should have the signature <tt>(PROC . PARAMS) &rArr; OBJECT</tt>. It is called with the <tt>N</tt> parameters given to the SQL function converted into Scheme objects like by <tt>column-data</tt>. The return value is converted into an SQLite data object like by <tt>bind!</tt>. A return value of <tt>(void)</tt> corresponds to <tt>NULL</tt> in SQLite.</p>
     287<p><tt>PROC</tt> should have the signature <tt>(PROC . PARAMS) &rArr; OBJECT</tt>. It is called with the <tt>N</tt> parameters given to the SQL function converted into Scheme objects like by <tt>column-data</tt>. The return value is converted into an SQLite data object like by <tt>bind!</tt>. A return value satisfying <tt>sql-null?</tt> corresponds to <tt>NULL</tt> in SQLite.</p>
    287288<p><tt>STEP-PROC</tt> should have the signature <tt>(STEP-PROC SEED . PARAMS) &rArr; SEED</tt>. It is called with the parameters given to the SQL function for every row being processed. The seed value passed is initially the one given as an argument to <tt>define-function</tt>; for subsequent calls it is the last value returned by <tt>STEP-PROC</tt> and after completion of <tt>FINAL-PROC</tt> it will be the initial value again.</p>
    288289<p><tt>FINAL-PROC</tt> should have the signature <tt>(FINAL-PROC SEED) &rArr; OBJECT</tt> and transforms the last seed value into the value to be returned from the aggregate function. If it is not explicitly specified, <tt>STEP-PROC</tt> defaults to the identity function.</p>
     
    380381<td><tt>blob</tt></td></tr>
    381382<tr>
    382 <td><tt>(void)</tt></td>
     383<td><tt>sql-null?</tt></td>
    383384<td><tt>null</tt></td></tr></table></p>
    384385<p>Unless there is internal trouble in SQLite, this method should always succeeds and never throw an exception. For invalid parameter indices the method just silently does nothing.</p></dd>
     
    419420<tr>
    420421<td><tt>null</tt></td>
    421 <td><tt>(void)</tt></td></tr></table></p>
     422<td><tt>sql-null?</tt></td></tr></table></p>
    422423<p>The declared type of a column is considered to be boolean if the type declaration contains the character sequence &quot;bool&quot; anywhere, ignoring case.</p>
    423424<p>This procedure always succeeds and never throws an exception.</p></dd>
     
    479480<h3>Version</h3>
    480481<ul>
     482<li>3.3.0 Switched to using <tt>(sql-null)</tt> for <tt>NULL</tt> values</li>
    481483<li>3.2.1 Added a test suite</li>
    482484<li>3.2.0 Removed the unsafe busy handler and timeout APIs, since a safe API exists</li>
  • release/4/sqlite3/trunk/sqlite3.meta

    r15334 r15344  
    66 (category db)
    77 (eggdoc "doc.scm")
    8  (needs check-errors synch miscmacros matchable)
     8 (needs check-errors synch miscmacros matchable sql-null)
    99 (license "BSD")
    1010 (author "Thomas Chust")
  • release/4/sqlite3/trunk/sqlite3.scm

    r15334 r15344  
    2121    ; These may have to be changed if definitions are added,
    2222    ; removed or reordered:
    23     sqlite3#g104 sqlite3#g304 sqlite3#g422 sqlite3#g508)
     23    sqlite3#g166 sqlite3#g366 sqlite3#g484 sqlite3#g570)
    2424  (bound-to-procedure
    2525    ##sys#expand-home-path
     
    7575  )
    7676
    77 (import
    78   scheme srfi-1 srfi-13 srfi-18 srfi-69
    79   chicken data-structures extras foreign lolevel
    80   type-errors type-checks synch miscmacros matchable)
    81 
    82 (require-library
     77(import scheme chicken foreign)
     78
     79(use
    8380  srfi-1 srfi-13 srfi-18 srfi-69
    8481  data-structures extras lolevel
    85   type-errors type-checks synch miscmacros matchable)
     82  type-errors type-checks synch miscmacros matchable sql-null)
    8683
    8784;;; Foreign types & values
     
    9592      (enum cname)
    9693      (lambda (v)
    97   (case v
    98     [(sv) (foreign-value cv int)]
    99     ...
    100     [else
    101       (error-argument-type 'sname v "enumeration value")]))
    102       (lambda (v)
    103   (select v
    104     [((foreign-value cv int)) 'sv]
    105     ...
    106     [else
    107       (error-argument-type 'sname v "enumeration index")])))]))
     94        (case v
     95          [(sv) (foreign-value cv int)]
     96          ...
     97          [else
     98            (error-argument-type 'sname v "enumeration value")]))
     99            (lambda (v)
     100        (select v
     101          [((foreign-value cv int)) 'sv]
     102          ...
     103          [else
     104            (error-argument-type 'sname v "enumeration index")])))]))
    108105
    109106(%define-enum-type (sqlite3:status "sqlite3_status")
     
    253250
    254251(define (hash-table-tree-ref
    255     ht-tree keys
    256     #!optional
    257     (thunk (cut abort
    258       (make-composite-condition
    259         (make-exn-condition 'hash-table-tree-ref
    260           "hash-table-tree does not contain path"
    261           ht-tree keys)
    262         (make-property-condition 'access)))))
     252          ht-tree keys
     253          #!optional
     254          (thunk (cut abort
     255            (make-composite-condition
     256              (make-exn-condition 'hash-table-tree-ref
     257                "hash-table-tree does not contain path"
     258                ht-tree keys)
     259              (make-property-condition 'access)))))
    263260  (let/cc return
    264     (let loop ([ht ht-tree]
    265   [keys keys])
     261    (let loop ([ht ht-tree] [keys keys])
    266262      (if (null? keys)
    267263  ht
     
    282278
    283279(define-external (chicken_sqlite3_collation_stub
    284       (scheme-object qn) (int la)
    285       (c-pointer da) (int lb)
    286       (c-pointer db)) int
     280                  (scheme-object qn) (int la)
     281                  (c-pointer da) (int lb)
     282                  (c-pointer db)) int
    287283  (let/cc return
    288284    (let ([r #f])
    289285      (dynamic-wind
    290   noop
    291   (lambda ()
    292     (handle-exceptions exn
    293       (print-error "in collation function" exn)
    294       (let ([a (make-string la)]
    295     [b (make-string lb)])
    296         (move-memory! da a la)
    297         (move-memory! db b lb)
    298         (set! r
    299     ((vector-ref
    300       (call-with/synch *collations*
    301         (cute hash-table-tree-ref <> qn))
    302       1)
    303       a b)))))
    304   (lambda ()
    305     (if (fixnum? r)
    306       (return r)
    307       (begin
    308         (print-error "in collation function: invalid return value" (->string r))
    309         (return 0))))))))
     286        noop
     287        (lambda ()
     288          (handle-exceptions exn
     289            (print-error "in collation function" exn)
     290            (let ([a (make-string la)]
     291                  [b (make-string lb)])
     292              (move-memory! da a la)
     293              (move-memory! db b lb)
     294              (set! r
     295                ((vector-ref
     296                  (call-with/synch *collations*
     297                    (cute hash-table-tree-ref <> qn))
     298                  1)
     299                  a b)))))
     300        (lambda ()
     301          (if (fixnum? r)
     302            (return r)
     303            (begin
     304              (print-error "in collation function: invalid return value" (->string r))
     305              (return 0))))))))
    310306
    311307(define sqlite3_create_collation
     
    317313    else
    318314    return(sqlite3_create_collation(db, name, SQLITE_UTF8,
    319   (void *)qn,
    320   (int (*)(void *,
    321       int, const void *,
    322       int, const void *))
    323   &chicken_sqlite3_collation_stub));
     315            (void *)qn,
     316            (int (*)(void *,
     317                int, const void *,
     318                int, const void *))
     319            &chicken_sqlite3_collation_stub));
    324320EOS
    325321    ))
     
    342338    (cond
    343339      [(sqlite3_create_collation db name #f)
    344   => (abort-sqlite3-error 'define-collation db name)]
     340        => (abort-sqlite3-error 'define-collation db name)]
    345341      [else
    346   (let ([qn (list (pointer->address (database-ptr db)) name)])
    347     (call-with/synch *collations*
    348       (lambda (col)
    349         (cond [(hash-table-tree-ref/default col qn #f)
    350     => (lambda (info)
    351       (hash-table-tree-delete! col qn)
    352       (object-release (vector-ref info 0)))]))))])))
     342        (let ([qn (list (pointer->address (database-ptr db)) name)])
     343          (call-with/synch *collations*
     344            (lambda (col)
     345              (cond [(hash-table-tree-ref/default col qn #f)
     346                => (lambda (info)
     347                    (hash-table-tree-delete! col qn)
     348                    (object-release (vector-ref info 0)))]))))])))
    353349
    354350;;; SQL function interface
     
    367363        args i)
    368364        [(integer)
    369     ((foreign-lambda* integer
    370         (((c-pointer sqlite3:value) args) (int i))
    371         "return(sqlite3_value_double(args[i]));")
    372       args i)]
     365          ((foreign-lambda* integer
     366              (((c-pointer sqlite3:value) args) (int i))
     367              "return(sqlite3_value_double(args[i]));")
     368            args i)]
    373369        [(float)
    374     ((foreign-lambda* double
    375         (((c-pointer sqlite3:value) args) (int i))
    376         "return(sqlite3_value_double(args[i]));")
    377       args i)]
     370          ((foreign-lambda* double
     371              (((c-pointer sqlite3:value) args) (int i))
     372              "return(sqlite3_value_double(args[i]));")
     373            args i)]
    378374        [(text)
    379     ((foreign-primitive scheme-object
    380         (((c-pointer sqlite3:value) args) (int i))
    381         "int n = sqlite3_value_bytes(args[i]);"
    382         "C_word *s = C_alloc(C_SIZEOF_STRING(n));"
    383         "return(C_string(&s, n, (char *)sqlite3_value_text(args[i])));")
    384       args i)]
     375          ((foreign-primitive scheme-object
     376              (((c-pointer sqlite3:value) args) (int i))
     377              "int n = sqlite3_value_bytes(args[i]);"
     378              "C_word *s = C_alloc(C_SIZEOF_STRING(n));"
     379              "return(C_string(&s, n, (char *)sqlite3_value_text(args[i])));")
     380            args i)]
    385381        [(blob)
    386     ((foreign-primitive scheme-object
    387         (((c-pointer sqlite3:value) args) (int i))
    388         "int n = sqlite3_value_bytes(args[i]);"
    389         "C_word *s = C_alloc(C_SIZEOF_STRING(n));"
    390         "return(C_bytevector(&s, n, (char *)sqlite3_value_blob(args[i])));")
    391       args i)]
     382          ((foreign-primitive scheme-object
     383              (((c-pointer sqlite3:value) args) (int i))
     384              "int n = sqlite3_value_bytes(args[i]);"
     385              "C_word *s = C_alloc(C_SIZEOF_STRING(n));"
     386              "return(C_bytevector(&s, n, (char *)sqlite3_value_blob(args[i])));")
     387            args i)]
    392388        [else
    393     (void)])
     389          (sql-null)])
    394390  (loop (add1 i))))))
    395391
     
    398394    [(blob? v)
    399395      ((foreign-lambda* void
    400     ((sqlite3:context ctx) (scheme-pointer v) (int n))
    401     "sqlite3_result_blob(ctx, v, n, SQLITE_TRANSIENT);")
    402   ctx v (blob-size v))]
     396          ((sqlite3:context ctx) (scheme-pointer v) (int n))
     397          "sqlite3_result_blob(ctx, v, n, SQLITE_TRANSIENT);")
     398        ctx v (blob-size v))]
    403399    [(or (and (fixnum? v) v) (and (boolean? v) (if v 1 0)))
    404400      => (lambda (v)
    405     ((foreign-lambda void "sqlite3_result_int" sqlite3:context int)
    406       ctx v))]
     401          ((foreign-lambda void "sqlite3_result_int" sqlite3:context int)
     402            ctx v))]
    407403    [(real? v)
    408404      ((foreign-lambda void "sqlite3_result_double" sqlite3:context double)
    409   ctx v)]
     405        ctx v)]
    410406    [(string? v)
    411407      ((foreign-lambda* void
    412     ((sqlite3:context ctx) (scheme-pointer v) (int n))
    413     "sqlite3_result_text(ctx, v, n, SQLITE_TRANSIENT);")
    414   ctx v (string-length v))]
    415     [(eq? v (void))
     408          ((sqlite3:context ctx) (scheme-pointer v) (int n))
     409          "sqlite3_result_text(ctx, v, n, SQLITE_TRANSIENT);")
     410        ctx v (string-length v))]
     411    [(sql-null? v)
    416412      ((foreign-lambda void "sqlite3_result_null" sqlite3:context)
    417   ctx)]
     413        ctx)]
    418414    [else
    419       (error-argument-type 'set-result! v "blob, number, boolean, string or void")]))
     415      (error-argument-type 'set-result! v "blob, number, boolean, string or sql-null")]))
    420416
    421417(define sqlite3_user_data
     
    428424      noop
    429425      (lambda ()
    430   (handle-exceptions exn
    431     (print-error "in SQL function" exn)
    432     (set-result!
    433       ctx
    434       (apply (vector-ref
    435     (call-with/synch *functions*
    436       (cute hash-table-tree-ref <> (sqlite3_user_data ctx)))
    437     1)
    438         (parameter-data n args)))))
    439       (lambda ()
    440   (return (void))))))
     426        (handle-exceptions exn
     427          (print-error "in SQL function" exn)
     428          (set-result!
     429            ctx
     430            (apply (vector-ref
     431                      (call-with/synch *functions*
     432                        (cute hash-table-tree-ref <> (sqlite3_user_data ctx)))
     433                      1)
     434              (parameter-data n args)))))
     435      (lambda ()
     436        (return (void))))))
    441437
    442438(define sqlite3_aggregate_context
     
    450446      noop
    451447      (lambda ()
    452   (handle-exceptions exn
    453     (print-error "in step of SQL function" exn)
    454     (let ([info (call-with/synch *functions*
    455     (cute hash-table-tree-ref <> (sqlite3_user_data ctx)))])
    456       (call-with/synch *seeds*
    457         (cute hash-table-update!/default
    458     <>
    459     (sqlite3_aggregate_context ctx)
    460     (lambda (seed)
    461       (apply (vector-ref info 1) seed (parameter-data n args)))
    462     (vector-ref info 2))))))
    463       (lambda ()
    464   (return (void))))))
     448        (handle-exceptions exn
     449          (print-error "in step of SQL function" exn)
     450          (let ([info (call-with/synch *functions*
     451                        (cute hash-table-tree-ref <> (sqlite3_user_data ctx)))])
     452            (call-with/synch *seeds*
     453              (cute hash-table-update!/default
     454                <>
     455                (sqlite3_aggregate_context ctx)
     456                (lambda (seed)
     457                  (apply (vector-ref info 1) seed (parameter-data n args)))
     458                (vector-ref info 2))))))
     459      (lambda ()
     460        (return (void))))))
    465461
    466462(define-external (chicken_sqlite3_final_stub (c-pointer ctx))
     
    469465    (let ([agc (sqlite3_aggregate_context ctx)])
    470466      (dynamic-wind
    471   noop
    472   (lambda ()
    473     (handle-exceptions exn
    474       (print-error "in final of SQL function" exn)
    475       (let ([info (call-with/synch *functions*
    476       (cute hash-table-tree-ref <> (sqlite3_user_data ctx)))])
    477         (cond
    478     [((vector-ref info 3)
    479       (call-with/synch *seeds*
    480         (cute hash-table-ref/default <> agc (vector-ref info 2))))
    481       => (cute set-result! ctx <>)]
    482     [else
    483       (set-result! ctx (void))]))))
    484   (lambda ()
    485     (call-with/synch *seeds*
    486       (cute hash-table-delete! <> agc))
    487     (return (void)))))))
     467        noop
     468        (lambda ()
     469          (handle-exceptions exn
     470            (print-error "in final of SQL function" exn)
     471            (let ([info (call-with/synch *functions*
     472            (cute hash-table-tree-ref <> (sqlite3_user_data ctx)))])
     473              (cond
     474          [((vector-ref info 3)
     475            (call-with/synch *seeds*
     476              (cute hash-table-ref/default <> agc (vector-ref info 2))))
     477            => (cute set-result! ctx <>)]
     478          [else
     479            (set-result! ctx (sql-null))]))))
     480        (lambda ()
     481          (call-with/synch *seeds*
     482            (cute hash-table-delete! <> agc))
     483          (return (void)))))))
    488484
    489485(define define-function
     
    495491      (check-procedure 'define-function proc)
    496492      (let ([qn (object-evict (list (pointer->address (database-ptr db)) name))])
    497   (cond
    498     [((foreign-lambda* sqlite3:status
    499         ((sqlite3:database db)
    500     (c-string name) (int n) (scheme-object qn))
     493        (cond
     494          [((foreign-lambda* sqlite3:status
     495              ((sqlite3:database db)
     496                (c-string name) (int n) (scheme-object qn))
    501497#<<EOS
    502         return(sqlite3_create_function(db, name, n, SQLITE_UTF8,
    503       (void *)qn,
    504       (void (*)(sqlite3_context *, int,
    505           sqlite3_value **))
    506       &chicken_sqlite3_function_stub,
    507       NULL,
    508       NULL));
     498            return(sqlite3_create_function(db, name, n, SQLITE_UTF8,
     499                    (void *)qn,
     500                    (void (*)(sqlite3_context *, int,
     501                        sqlite3_value **))
     502                    &chicken_sqlite3_function_stub,
     503                    NULL,
     504                    NULL));
    509505EOS
    510506      )
    511507      db name n qn)
    512508      => (lambda (s)
    513     (object-release qn)
    514     ((abort-sqlite3-error 'define-function db name n proc) s))]
     509          (object-release qn)
     510          ((abort-sqlite3-error 'define-function db name n proc) s))]
    515511    [else
    516     (call-with/synch *functions*
    517       (cute hash-table-tree-set! <> qn (vector qn proc)))]))]
     512      (call-with/synch *functions*
     513        (cute hash-table-tree-set! <> qn (vector qn proc)))]))]
    518514    [(db name n step-proc seed . final-proc)
    519515      (check-database 'define-function db)
     
    521517      (check-cardinal-number 'define-function n)
    522518      (let ([final-proc (optional final-proc identity)])
    523   (check-procedure 'define-function step-proc)
    524   (check-procedure 'define-function final-proc)
    525   (let ([qn (object-evict (list (pointer->address (database-ptr db)) name))])
    526     (cond
    527       [((foreign-lambda* sqlite3:status
    528     ((sqlite3:database db)
    529       (c-string name) (int n) (scheme-object qn))
     519        (check-procedure 'define-function step-proc)
     520        (check-procedure 'define-function final-proc)
     521        (let ([qn (object-evict (list (pointer->address (database-ptr db)) name))])
     522          (cond
     523            [((foreign-lambda* sqlite3:status
     524                ((sqlite3:database db)
     525                  (c-string name) (int n) (scheme-object qn))
    530526#<<EOS
    531     return(sqlite3_create_function(db, name, n, SQLITE_UTF8,
    532         (void *)qn,
    533         NULL,
    534         (void (*)(sqlite3_context *, int,
    535       sqlite3_value **))
    536         &chicken_sqlite3_step_stub,
    537         ((void (*)(sqlite3_context *))
    538           &chicken_sqlite3_final_stub)));
     527                return(sqlite3_create_function(db, name, n, SQLITE_UTF8,
     528                          (void *)qn,
     529                          NULL,
     530                          (void (*)(sqlite3_context *,
     531                              int, sqlite3_value **))
     532                          &chicken_sqlite3_step_stub,
     533                          (void (*)(sqlite3_context *))
     534                          &chicken_sqlite3_final_stub));
    539535EOS
    540         )
    541         db name n qn)
    542         => (lambda (s)
    543       (object-release qn)
    544       ((abort-sqlite3-error
    545           'define-function db name n step-proc seed final-proc) s))]
    546       [else
    547         (call-with/synch *functions*
    548     (cute hash-table-tree-set! <> qn (vector qn step-proc seed final-proc)))])))]))
     536              )
     537              db name n qn)
     538              => (lambda (s)
     539                  (object-release qn)
     540                  ((abort-sqlite3-error
     541                      'define-function db name n step-proc seed final-proc) s))]
     542            [else
     543              (call-with/synch *functions*
     544                (cute hash-table-tree-set! <> qn (vector qn step-proc seed final-proc)))])))]))
    549545
    550546;;; Database interface
     
    560556    (cond
    561557      [((foreign-lambda sqlite3:status "sqlite3_open"
    562     nonnull-c-string (c-pointer sqlite3:database))
    563   (##sys#expand-home-path path) #$db)
    564   => (abort-sqlite3-error 'open-database #f path)]
     558          nonnull-c-string (c-pointer sqlite3:database))
     559        (##sys#expand-home-path path) #$db)
     560        => (abort-sqlite3-error 'open-database #f path)]
    565561      [else
    566   (make-database db #f)])))
     562        (make-database db #f)])))
    567563
    568564;; Set application busy handler.  Does not use a callback, so it is safe
     
    589585           (* delay (- count (- ndelay 1)))))])
    590586  (let ([delay (if (> (+ prior delay) timeout)
    591     (- timeout prior)
    592     delay)])
     587                (- timeout prior)
     588                delay)])
    593589    (cond
    594590      [(<= delay 0) #f]
     
    620616
    621617;; Close a database or statement handle
    622 (define (finalize! db-or-stmt)
    623   (cond
    624     [(database? db-or-stmt)
     618(define finalize!
     619  (match-lambda
     620    [(? database? db)
    625621      (cond
    626   [(not (database-ptr db-or-stmt))
    627     (void)]
    628   [((foreign-safe-lambda sqlite3:status "sqlite3_close" sqlite3:database) db-or-stmt)
    629     => (abort-sqlite3-error 'finalize! db-or-stmt db-or-stmt)]
    630   [else
    631     (let ([id (pointer->address (database-ptr db-or-stmt))]
    632         [release-qns (lambda (_ info) (object-release (vector-ref info 0)))])
    633       (call-with/synch *collations*
    634         (cute hash-table-tree-clear! <> id release-qns))
    635       (call-with/synch *functions*
    636         (cute hash-table-tree-clear! <> id release-qns)))
    637     (database-ptr-set! db-or-stmt #f)
    638     (database-busy-handler-set! db-or-stmt #f)])]
    639     [(statement? db-or-stmt)
     622        [(not (database-ptr db))
     623          (void)]
     624        [((foreign-safe-lambda sqlite3:status "sqlite3_close" sqlite3:database) db)
     625          => (abort-sqlite3-error 'finalize! db db)]
     626        [else
     627          (let ([id (pointer->address (database-ptr db))]
     628              [release-qns (lambda (_ info) (object-release (vector-ref info 0)))])
     629            (call-with/synch *collations*
     630              (cute hash-table-tree-clear! <> id release-qns))
     631            (call-with/synch *functions*
     632              (cute hash-table-tree-clear! <> id release-qns)))
     633          (database-ptr-set! db #f)
     634          (database-busy-handler-set! db #f)])]
     635    [(? statement? stmt)
    640636      (cond
    641   [(not (statement-ptr db-or-stmt))
    642     (void)]
    643   [((foreign-lambda sqlite3:status "sqlite3_finalize" sqlite3:statement) db-or-stmt)
    644     => (abort-sqlite3-error 'finalize! (statement-database db-or-stmt) db-or-stmt)]
    645   [else
    646     (statement-ptr-set! db-or-stmt #f)])]))
     637        [(not (statement-ptr stmt))
     638          (void)]
     639        [((foreign-lambda sqlite3:status "sqlite3_finalize" sqlite3:statement) stmt)
     640          => (abort-sqlite3-error 'finalize! (statement-database stmt) stmt)]
     641        [else
     642          (statement-ptr-set! stmt #f)])]))
    647643
    648644;;; Statement interface
     
    655651    (let-location ([stmt c-pointer] [tail c-string])
    656652      (cond
    657   [((foreign-safe-lambda sqlite3:status "sqlite3_prepare"
    658       sqlite3:database scheme-pointer int
    659       (c-pointer sqlite3:statement)
    660       (c-pointer (const c-string)))
    661     db (string-append sql "\x00") (string-length sql) #$stmt #$tail)
    662     => (lambda (err)
    663         (case err
    664     [(busy)
    665       (let ([h (database-busy-handler db)])
    666         (cond
    667           [(and h (h db retries))
    668       (retry (add1 retries))]
    669           [else
    670       ((abort-sqlite3-error 'prepare db db sql) err)]))]
    671     [else
    672       ((abort-sqlite3-error 'prepare db db sql) err)]))]
    673   [else
    674     (values
    675       (make-statement stmt db sql)
    676       tail)]))))
     653        [((foreign-safe-lambda sqlite3:status "sqlite3_prepare"
     654            sqlite3:database scheme-pointer int
     655            (c-pointer sqlite3:statement)
     656            (c-pointer (const c-string)))
     657          db (string-append sql "\x00") (string-length sql) #$stmt #$tail)
     658          => (lambda (err)
     659              (case err
     660                [(busy)
     661                  (let ([h (database-busy-handler db)])
     662                    (cond
     663                      [(and h (h db retries))
     664                        (retry (add1 retries))]
     665                      [else
     666                        ((abort-sqlite3-error 'prepare db db sql) err)]))]
     667                [else
     668                  ((abort-sqlite3-error 'prepare db db sql) err)]))]
     669        [else
     670          (values
     671            (make-statement stmt db sql)
     672            tail)]))))
    677673
    678674;; Recompile an existing statement and transfer all bindings
     
    685681      noop
    686682      (lambda ()
    687   (let ([old (statement-ptr stmt)]
    688         [new (statement-ptr fresh)])
    689     (cond
    690       [((foreign-lambda sqlite3:status "sqlite3_transfer_bindings"
    691     c-pointer c-pointer)
    692         old new)
    693         => (abort-sqlite3-error 'repair! (statement-database stmt) stmt)]
    694       [else
    695         (statement-ptr-set! stmt new)
    696         (statement-ptr-set! fresh old)])))
    697       (lambda ()
    698   (finalize! fresh)))))
     683        (let ([old (statement-ptr stmt)]
     684              [new (statement-ptr fresh)])
     685          (cond
     686            [((foreign-lambda sqlite3:status "sqlite3_transfer_bindings"
     687                c-pointer c-pointer)
     688              old new)
     689              => (abort-sqlite3-error 'repair! (statement-database stmt) stmt)]
     690            [else
     691              (statement-ptr-set! stmt new)
     692              (statement-ptr-set! fresh old)])))
     693      (lambda ()
     694        (finalize! fresh)))))
    699695
    700696;; Reset an existing statement to process it again
     
    717713  (check-statement 'bind-parameter-index stmt)
    718714  (let ([i ((foreign-lambda int "sqlite3_bind_parameter_index"
    719         sqlite3:statement nonnull-c-string)
    720       stmt name)])
     715              sqlite3:statement nonnull-c-string)
     716            stmt name)])
    721717    (if (zero? i)
    722718      #f
     
    737733    [(blob? v)
    738734      (cond [((foreign-lambda* sqlite3:status
    739     ((sqlite3:statement stmt) (int i) (scheme-pointer v) (int n))
    740     "return(sqlite3_bind_blob(stmt, i, v, n, SQLITE_TRANSIENT));")
    741         stmt (add1 i) v (blob-size v))
     735                ((sqlite3:statement stmt) (int i) (scheme-pointer v) (int n))
     736                "return(sqlite3_bind_blob(stmt, i, v, n, SQLITE_TRANSIENT));")
     737              stmt (add1 i) v (blob-size v))
    742738        => (abort-sqlite3-error 'bind! (statement-database stmt) stmt i v)])]
    743739    [(or (and (fixnum? v) v) (and (boolean? v) (if v 1 0)))
    744740      => (lambda (v)
    745     (cond [((foreign-lambda sqlite3:status "sqlite3_bind_int"
    746         sqlite3:statement int int)
    747       stmt (add1 i) v)
    748       => (abort-sqlite3-error 'bind! (statement-database stmt) stmt i v)]))]
     741          (cond [((foreign-lambda sqlite3:status "sqlite3_bind_int"
     742                    sqlite3:statement int int)
     743                  stmt (add1 i) v)
     744            => (abort-sqlite3-error 'bind! (statement-database stmt) stmt i v)]))]
    749745    [(real? v)
    750746      (cond [((foreign-lambda sqlite3:status "sqlite3_bind_double"
    751     sqlite3:statement int double)
    752         stmt (add1 i) v)
     747                sqlite3:statement int double)
     748              stmt (add1 i) v)
    753749        => (abort-sqlite3-error 'bind! (statement-database stmt) stmt i v)])]
    754750    [(string? v)
    755751      (cond [((foreign-lambda* sqlite3:status
    756     ((sqlite3:statement stmt) (int i) (scheme-pointer v) (int n))
    757     "return(sqlite3_bind_text(stmt, i, v, n, SQLITE_TRANSIENT));")
    758         stmt (add1 i) v (string-length v))
     752                ((sqlite3:statement stmt) (int i) (scheme-pointer v) (int n))
     753                "return(sqlite3_bind_text(stmt, i, v, n, SQLITE_TRANSIENT));")
     754              stmt (add1 i) v (string-length v))
    759755        => (abort-sqlite3-error 'bind! (statement-database stmt) stmt i v)])]
    760     [(eq? v (void))
     756    [(sql-null? v)
    761757      (cond [((foreign-lambda sqlite3:status "sqlite3_bind_null" sqlite3:statement int)
    762         stmt (add1 i))
     758              stmt (add1 i))
    763759        => (abort-sqlite3-error 'bind! (statement-database stmt) stmt i)])]
    764760    [else
    765       (error-argument-type 'bind! v "blob, number, boolean, string or void")]))
     761      (error-argument-type 'bind! v "blob, number, boolean, string or sql-null")]))
    766762
    767763; Helper
     
    773769    (let loop ([i 0] [params params])
    774770      (match params
    775   [((? keyword? k) v . rest)
    776     (cond
    777       [(bind-parameter-index stmt (string-append ":" (keyword->string k)))
    778         => (lambda (j)
    779        (hash-table-set! vs j v)
    780        (loop i rest))]
    781       [else
    782         (error-argument-type loc k "value or keyword matching a bind parameter name")])]
    783   [(v . rest)
    784     (hash-table-set! vs i v)
    785     (loop (add1 i) rest)]
    786   [()
    787     (void)]))
     771        [((? keyword? k) v . rest)
     772          (cond
     773            [(bind-parameter-index stmt (string-append ":" (keyword->string k)))
     774              => (lambda (j)
     775             (hash-table-set! vs j v)
     776             (loop i rest))]
     777            [else
     778              (error-argument-type loc k "value or keyword matching a bind parameter name")])]
     779        [(v . rest)
     780          (hash-table-set! vs i v)
     781          (loop (add1 i) rest)]
     782        [()
     783          (void)]))
    788784    (if (= (hash-table-size vs) cnt)
    789785      (unless (zero? cnt)
    790   (hash-table-walk vs (cut bind! stmt <> <>)))
     786        (hash-table-walk vs (cut bind! stmt <> <>)))
    791787      (abort
    792   (make-composite-condition
    793     (make-exn-condition
    794       loc
    795       (conc "bad parameter count - received " (hash-table-size vs) " but expected " cnt))
    796     (make-property-condition 'arity)
    797     (make-sqlite3-condition 'error))))))
     788        (make-composite-condition
     789          (make-exn-condition
     790            loc
     791            (conc "bad parameter count - received " (hash-table-size vs) " but expected " cnt))
     792          (make-property-condition 'arity)
     793          (make-sqlite3-condition 'error))))))
    798794
    799795(define (bind-parameters! stmt . params)
     
    857853  (case (column-type stmt i)
    858854    [(integer)
    859       (if (let ([declared (column-declared-type stmt i)])
    860       (and declared (string-contains-ci declared "bool")))
    861   ((foreign-lambda bool "sqlite3_column_int" sqlite3:statement int) stmt i)
    862   ((foreign-lambda integer "sqlite3_column_double" sqlite3:statement int) stmt i))]
     855      (if (and-let* ([type (column-declared-type stmt i)])
     856            (string-contains-ci type "bool"))
     857        ((foreign-lambda bool "sqlite3_column_int" sqlite3:statement int) stmt i)
     858        ((foreign-lambda integer "sqlite3_column_double" sqlite3:statement int) stmt i))]
    863859    [(float)
    864860      ((foreign-lambda double "sqlite3_column_double" sqlite3:statement int) stmt i)]
    865861    [(text)
    866862      ((foreign-primitive scheme-object ((sqlite3:statement stmt) (int i))
    867     "int n = sqlite3_column_bytes(stmt, i);"
    868     "C_word *s = C_alloc(C_SIZEOF_STRING(n));"
    869     "return(C_string(&s, n, (char *)sqlite3_column_text(stmt, i)));")
    870   stmt i)]
     863          "int n = sqlite3_column_bytes(stmt, i);"
     864          "C_word *s = C_alloc(C_SIZEOF_STRING(n));"
     865          "return(C_string(&s, n, (char *)sqlite3_column_text(stmt, i)));")
     866        stmt i)]
    871867    [(blob)
    872868      ((foreign-primitive scheme-object ((sqlite3:statement stmt) (int i))
    873     "int n = sqlite3_column_bytes(stmt, i);"
    874     "C_word *s = C_alloc(C_SIZEOF_STRING(n));"
    875     "return(C_bytevector(&s, n, (char *)sqlite3_column_blob(stmt, i)));")
    876   stmt i)]
     869          "int n = sqlite3_column_bytes(stmt, i);"
     870          "C_word *s = C_alloc(C_SIZEOF_STRING(n));"
     871          "return(C_bytevector(&s, n, (char *)sqlite3_column_blob(stmt, i)));")
     872        stmt i)]
    877873    [else
    878       (void)]))
     874      (sql-null)]))
    879875
    880876;;; Easy statement interface
     
    884880(define (call-with-temporary-statements proc db . sqls)
    885881  (check-database 'call-with-temporary-statements db)
    886   (let ([stmts #f] [e #f])
     882  (let ([stmts #f] [exn #f])
    887883    (dynamic-wind
    888884      (lambda ()
    889   (unless stmts
    890     (set! stmts (map (cute prepare db <>) sqls))))
    891       (lambda ()
    892   (handle-exceptions exn (set! e exn)
    893     (apply proc stmts)))
    894       (lambda ()
    895   (when stmts
    896     (map finalize! stmts) ;; leaks if error occurs before last stmt
    897     (set! stmts #f))
    898   (and-let* ([exn e])
    899     (set! e #f)
    900     (signal exn))))))
     885        (unless stmts
     886          (set! stmts (map (cute prepare db <>) sqls))))
     887      (lambda ()
     888        (handle-exceptions e (set! exn e)
     889          (apply proc stmts)))
     890      (lambda ()
     891        (and-let* ([s stmts])
     892          (set! stmts #f)
     893          (for-each finalize! s)) ;; leaks if error occurs before last stmt
     894        (and-let* ([e exn])
     895          (set! exn #f)
     896          (signal e))))))
    901897
    902898(define-syntax %define/statement+params
     
    905901       body ...)
    906902      (define name
    907   (let ([impl (lambda (init ... stmt params) body ...)])
    908     (lambda (init ... db-or-stmt . params)
    909       (cond
    910         [(database? db-or-stmt)
    911     (call-with-temporary-statements
    912       (cute impl init ... <> (cdr params))
    913       db-or-stmt (car params))]
    914         [(statement? db-or-stmt)
    915     (impl init ... db-or-stmt params)]
    916         [else
    917     (error-argument-type loc db-or-stmt "database or statement")]))))]
     903        (let ([impl (lambda (init ... stmt params) body ...)])
     904          (lambda (init ... db-or-stmt . params)
     905            (cond
     906              [(database? db-or-stmt)
     907                (call-with-temporary-statements
     908                  (cute impl init ... <> (cdr params))
     909                  db-or-stmt (car params))]
     910              [(statement? db-or-stmt)
     911                (impl init ... db-or-stmt params)]
     912              [else
     913                (error-argument-type loc db-or-stmt "database or statement")]))))]
    918914    [(%define/statement+params (name (init ...) (stmt params))
    919915       body ...)
    920916      (%define/statement+params ((name 'name) (init ...) (stmt params))
    921   body ...)]
     917        body ...)]
    922918    [(%define/statement+params (name stmt params)
    923919       body ...)
    924920      (%define/statement+params ((name 'name) () (stmt params))
    925   body ...)]))
     921        body ...)]))
    926922
    927923;; Step through a statement and ignore possible results
     
    10111007    (abort
    10121008      (make-composite-condition
    1013   (make-exn-condition 'with-transaction
    1014     "bad argument: expected deferred, immediate or exclusive"
    1015     type)
    1016   (make-property-condition 'type))))
    1017   (let ([success? #f] [e #f])
     1009        (make-exn-condition 'with-transaction
     1010          "bad argument: expected deferred, immediate or exclusive"
     1011          type)
     1012        (make-property-condition 'type))))
     1013  (let ([success? #f] [exn #f])
    10181014    (dynamic-wind
    10191015      (lambda ()
    1020   (execute db
    1021     (string-append "BEGIN " (symbol->string type) " TRANSACTION;")))
    1022       (lambda ()
    1023   (handle-exceptions exn (begin
    1024       (print-error "with-transaction" exn)
    1025       (set! e exn))
    1026     (set! success? (thunk))
    1027     success?))
    1028       (lambda ()
    1029   (execute db
    1030     (if success?
    1031       "COMMIT TRANSACTION;"
    1032       "ROLLBACK TRANSACTION;"))
    1033   (and-let* ([exn e])
    1034     (set! e #f)
    1035     (signal exn))))))
     1016        (execute db
     1017          (string-append "BEGIN " (symbol->string type) " TRANSACTION;")))
     1018      (lambda ()
     1019        (handle-exceptions e (begin
     1020                               (print-error "with-transaction" exn)
     1021                               (set! exn e))
     1022          (set! success? (thunk))
     1023          success?))
     1024      (lambda ()
     1025        (execute db
     1026          (if success?
     1027            "COMMIT TRANSACTION;"
     1028            "ROLLBACK TRANSACTION;"))
     1029        (and-let* ([e exn])
     1030          (set! exn #f)
     1031          (signal e))))))
    10361032
    10371033;; Check if the given string is a valid SQL statement
  • release/4/sqlite3/trunk/tests/run.scm

    r15334 r15344  
    33;;;; Tests for the SQLite3 bindings
    44
    5 (use srfi-1 srfi-13 srfi-69 test sqlite3)
     5(use srfi-1 srfi-13 srfi-69 test sql-null sqlite3)
    66
    77;;; Some utilities
     
    148148  (test-group "simple statement interface"
    149149
    150     (let ([data (list (void) 42 3.5 "hallo" (string->blob "welt"))])
     150    (let ([data (list 42 3.5 "hallo" (string->blob "welt"))])
    151151      (test "data invariance"
    152152        data
     
    167167            (map (cut first-result get <>) (iota 2)))
    168168          db "SELECT v FROM Bool WHERE id = ?;")))
     169
     170    (test-assert "null invariance"
     171      (with-database+statement ([db ":memory:"]
     172                                [stmt "SELECT ?;"])
     173        (sql-null? (first-result stmt (sql-null)))))
    169174
    170175    (test "single value retrieval"
Note: See TracChangeset for help on using the changeset viewer.