Re: a Scheme48 wrapper for Sqlite3

>>>>> "IS" == Ivan Shmakov <[email protected]> writes:

 IS> I've made some changes to the code, but I'm currently too busy to
 IS> finish the work.  I'm therefore posting the code in its current
 IS> state in the hope that it might be useful to someone.

	I've reworked the code a bit, and the user-visible changes are
	roughly as follows.

    * The code is now rewritten to utilize the new Scheme48 FFI (for
      to-be Scheme 1.9.)

    * The error-signalling variants are now provided for a number of
      functions; these variants are: `sqlite3-open', `sqlite3-close',
      `sqlite3-prepare-2', `sqlite3-prepare',
      `sqlite3-prepared-finalize!', `sqlite3-prepared-reset!',
      `sqlite3-prepared-step!'.

    * The interfaces were extended by `sqlite3-column-name' (with error
      signalling) and `sqlite3-column-name-1' (without), mostly to allow
      for `sqlite3-exec' to be reimplemented.

    * The `sqlite3-exec' is now reimplemented on top of the rest of the
      interface; both `sqlite3-exec-1' and sqlite3_s48_exec () are gone.

    * An example makefile is provided.

	I've tested it with Scheme48 (as of [1]), and it appears to
	build and work correctly:

cd ~/devel/scheme48-sqlite/
make -k 
cc -g -Wall -I/.../include  -c -o sqlite3-int.o sqlite3-int.c
sqlite3-int.c: In function 'sqlite3_s48_libversion':
sqlite3-int.c:85: warning: passing argument 2 of 's48_enter_byte_string_2' discards qualifiers from pointer target type
sqlite3-int.c: In function 'sqlite3_s48_errmsg':
sqlite3-int.c:167: warning: passing argument 2 of 's48_enter_byte_string_2' discards qualifiers from pointer target type
sqlite3-int.c: In function 'sqlite3_s48_column_name':
sqlite3-int.c:274: warning: passing argument 2 of 's48_enter_byte_string_2' discards qualifiers from pointer target type
sqlite3-int.c: In function 'sqlite3_s48_column_blob':
sqlite3-int.c:288: warning: passing argument 2 of 's48_enter_byte_vector_2' discards qualifiers from pointer target type
cc -g -Wall -o sqlite3-int.so sqlite3-int.o -shared -lsqlite3

Compilation finished at Mon Sep  8 11:41:52

Welcome to Scheme 48 1.9T (made by ivan on Mon Sep  8 11:38:33 NOVST 2008)
Copyright (c) 1993-2008 by Richard Kelsey and Jonathan Rees.
Please report bugs to [email protected].
Get more information at http://www.s48.org/.
Type ,? (comma question-mark) for help.
> ,config ,load sqlite3-packages.scm 
> ,new-package 
264> ,structure foo (export)
foo> ,open sqlite3 

warning: Structure has undefined exports [check-structure]
         #{structure 263 sqlite3-low}
         (sqlite3-exec-1)
foo> (define d (sqlite3-open "/tmp/foo.db"))
; no values returned
foo> (define (show . args)
       (write args)
       (newline))
; no values returned
foo> (sqlite3-exec d "SELECT 'foo' UNION SELECT 'bar'"
		   show 'unused)
(unused 1 #(#{byte-vector 98 97 114}) #(#{OS-string ("US-ASCII" "ANSI_X3.4-1968") "'foo'"}))
(unused 1 #(#{byte-vector 102 111 111}) #(#{OS-string ("US-ASCII" "ANSI_X3.4-1968") "'foo'"}))
#{Unspecific}
foo> 

[1] http://www.deinprogramm.de/cgi-bin/hgs48.cgi/rev/808c9731148689766698a36fbe8dc22bdda94f16

 IS> The things to be done are, roughly:

[...]

 IS> * an exception should be raised on receiving ``bad'' result code
 IS> (the functions needing the attention with regard to this issue
 IS> are currently given suffix `-1' in the code);

 IS> * remove sqlite3_s48_exec () and (sqlite3-exec-1 ...); implement
 IS> `sqlite3-exec' on top of `sqlite3-prepare' and
 IS> `sqlite3-prepared-step!'.

	I believe that these two are now done.

[...]

;;; "sqlite3.scm" -- Scheme48 wrapper for Sqlite3  -*- Scheme -*-
;; Features: sqlite3

;;; Copyright (C) 2008 Ivan Shmakov

;;; Code:

(import-dynamic-externals "./sqlite3-int")

(import-lambda-definition-2 sqlite3-s48-box ())

(import-lambda-definition-2 sqlite3-s48-libversion ())
(import-lambda-definition-2 sqlite3-s48-libversion-number ())

(import-lambda-definition-2 sqlite3-s48-free (pointer))

(import-lambda-definition-2 sqlite3-s48-open  (filename sqlite3-ptr))
(import-lambda-definition-2 sqlite3-s48-close (sqlite3-ptr))

(import-lambda-definition-2 sqlite3-s48-errcode (sqlite3-ptr))
(import-lambda-definition-2 sqlite3-s48-errmsg  (sqlite3-ptr))

(import-lambda-definition-2 sqlite3-s48-prepare-1
                            (sqlite3-ptr sql utf-16? prepared-ptr u-pair))
(import-lambda-definition-2 sqlite3-s48-finalize  (sqlite3-prepared-ptr))
(import-lambda-definition-2 sqlite3-s48-reset     (sqlite3-prepared-ptr))
(import-lambda-definition-2 sqlite3-s48-step      (sqlite3-prepared-ptr))

(import-lambda-definition-2 sqlite3-s48-data-count (sqlite3-prepared-ptr))
(import-lambda-definition-2 sqlite3-s48-column-type
                            (sqlite3-prepared-ptr column-index))
(import-lambda-definition-2 sqlite3-s48-column-name
                            (sqlite3-prepared-ptr column-index))
(import-lambda-definition-2 sqlite3-s48-column-blob
                            (sqlite3-prepared-ptr column-index))

;;; Utility

(define (vector-map! vec proc src-1 . srcs)
  (do ((l   (vector-length src-1))
       (i   0 (+ 1 i)))
      ((>=  i l))
    (let ((ref (lambda (vec) (vector-ref vec i))))
      (vector-set! vec i (apply proc (ref src-1)
                                (map  ref srcs))))))

;;; Types

(define-enumerated-type sqlite3-result :sqlite3-result
  sqlite3-result?
  sqlite3-results
  sqlite3-result-name
  sqlite3-result-code
  (ok           ;   0 SQLITE_OK
   error        ;   1 SQLITE_ERROR
   internal     ;   2 SQLITE_INTERNAL
   perm         ;   3 SQLITE_PERM
   abort        ;   4 SQLITE_ABORT
   busy         ;   5 SQLITE_BUSY
   locked       ;   6 SQLITE_LOCKED
   nomem        ;   7 SQLITE_NOMEM
   readonly     ;   8 SQLITE_READONLY
   interrupt    ;   9 SQLITE_INTERRUPT
   ioerr        ;  10 SQLITE_IOERR
   corrupt      ;  11 SQLITE_CORRUPT
   notfound     ;  12 SQLITE_NOTFOUND   (Internal Only)
   full         ;  13 SQLITE_FULL
   cantopen     ;  14 SQLITE_CANTOPEN
   protocol     ;  15 SQLITE_PROTOCOL
   empty        ;  16 SQLITE_EMPTY      (Internal Only)
   schema       ;  17 SQLITE_SCHEMA
   toobig       ;  18 SQLITE_TOOBIG
   constraint   ;  19 SQLITE_CONSTRAINT
   mismatch     ;  20 SQLITE_MISMATCH
   misuse       ;  21 SQLITE_MISUSE
   nolfs        ;  22 SQLITE_NOLFS
   auth         ;  23 SQLITE_AUTH
   n/a-24 n/a-25 n/a-26 n/a-27 n/a-28 n/a-29 n/a-30 n/a-31 n/a-32 n/a-33
   n/a-34 n/a-35 n/a-36 n/a-37 n/a-38 n/a-39 n/a-40 n/a-41 n/a-42 n/a-43
   n/a-44 n/a-45 n/a-46 n/a-47 n/a-48 n/a-49 n/a-50 n/a-51 n/a-52 n/a-53
   n/a-54 n/a-55 n/a-56 n/a-57 n/a-58 n/a-59 n/a-60 n/a-61 n/a-62 n/a-63
   n/a-64 n/a-65 n/a-66 n/a-67 n/a-68 n/a-69 n/a-70 n/a-71 n/a-72 n/a-73
   n/a-74 n/a-75 n/a-76 n/a-77 n/a-78 n/a-79 n/a-80 n/a-81 n/a-82 n/a-83
   n/a-84 n/a-85 n/a-86 n/a-87 n/a-88 n/a-89 n/a-90 n/a-91 n/a-92 n/a-93
   n/a-94 n/a-95 n/a-96 n/a-97 n/a-98 n/a-99
   row          ; 100 SQLITE_ROW
   done))       ; 101 SQLITE_DONE

; (define (sqlite3-result? object)
;   ;; .
;   (and (sqlite3-result-1? object)
;        (let ((i (sqlite3-result-index-1 object)))
;          ;; ignore all the non-assigned result codes
;          (or (<= i 23) (>= i 100)))))

(define (sqlite3-result<-integer code)
  ;; .
  (vector-ref sqlite3-results code))

(define-enumerated-type sqlite3-type :sqlite3-type
  sqlite3-type?
  sqlite3-types
  sqlite3-type-name
  sqlite3-type-code
  (integer      ; 1 SQLITE_INTEGER
   float        ; 2 SQLITE_FLOAT
   text         ; 3 SQLITE_TEXT
   blob         ; 4 SQLITE_BLOB
   null))       ; 5 SQLITE_NULL

(define (sqlite3-type<-integer code)
  ;; .
  (vector-ref sqlite3-types code))

(define-record-type sqlite3 :sqlite3
  (make-sqlite3 box)
  sqlite3?
  (box sqlite3-box set-sqlite3-box!))

(define-record-discloser :sqlite3
  (lambda (sqlite3)
    (list 'sqlite3)))

(define-record-type sqlite3-prepared :sqlite3-prepared
  (make-sqlite3-prepared box finished?)
  sqlite3-prepared?
  (box          sqlite3-prepared-box    set-sqlite3-prepared-box!)
  (finished?    sqlite3-prepared-finished?
                set-sqlite3-prepared-finished?!))

(define-record-discloser :sqlite3-prepared
  (lambda (sqlite3-prepared)
    (list 'sqlite3-prepared
          `(finished? ,(sqlite3-prepared-finished? sqlite3-prepared)))))

;; NB: meaningless
(define-record-resumer :sqlite3 #f)
(define-record-resumer :sqlite3-prepared #f)

;;; Simple wrappers

(define (make-call-wrapper proc callback name)
  (lambda args
    (call-with-values (lambda () (apply proc args))
      (lambda (r . rest)
        (apply callback
               (lambda (error-message)
                 (assertion-violation name
                                      error-message
                                      ;; FIXME: order of arguments here?
                                      (cons r rest)
                                      (sqlite3-result<-integer r) r))
               r rest)))))

(define make-call-ok-wrapper
  (let ((ok-code (sqlite3-result-code (sqlite3-result ok))))
    (lambda (proc callback name error-message)
      (define (check-and-call signal r . rest)
        (if (= r ok-code)
            (apply callback r rest)
            (signal error-message)))
      (make-call-wrapper proc check-and-call name))))

;;; Obtaining static information

(define (sqlite3-libversion)
  (x->os-string (sqlite3-s48-libversion)))

(define sqlite3-libversion-number sqlite3-s48-libversion-number)

(define (sqlite3-libversion-list)
  (let* ((n   (sqlite3-libversion-number))
         (z   (remainder    n          1000))
         (ye3 (remainder (- n    z) 1000000))
         (xe6            (- n (+ z ye3)))
         (y   (/ ye3 1000))
         (x   (/ xe6 1000000)))
    (list x y z)))

;;; Opening and closing database

(define (sqlite3-open-1 filename)
  (let* ((box (sqlite3-s48-box))
         (r   (sqlite3-s48-open (os-string->byte-vector
                                 (x->os-string filename))
                                box))
         (o   (make-sqlite3 box)))
    (add-finalizer! o sqlite3-close-1)
    ;; .
    (values r o)))

(define (sqlite3-close-1 sqlite3)
  ;; .
  (cond ((sqlite3-box sqlite3)
         => (lambda (box)
              (let ((r (sqlite3-s48-close box)))
                ;; FIXME: SQLITE_BUSY code is silently ignored
                (if (not (= r (sqlite3-result-code
                               (sqlite3-result busy))))
                    (set-sqlite3-box! sqlite3 #f))
                r)))))

(define sqlite3-open
  (make-call-ok-wrapper sqlite3-open-1
                        (lambda (r o) o)
                        'sqlite3-open
                        "sqlite3-s48-open failed"))

(define sqlite3-close
  (make-call-ok-wrapper sqlite3-close-1
                        (lambda (r) (unspecific))
                        'sqlite3-close
                        "sqlite3-s48-close failed"))

;;; Database status

(define (sqlite3-last-result sqlite3)
  (let ((r (sqlite3-s48-errcode (sqlite3-box sqlite3))))
    ;; .
    (sqlite3-result<-integer r)))

(define (sqlite3-last-error-message sqlite3)
  (let ((b (sqlite3-s48-errmsg  (sqlite3-box sqlite3))))
    ;; .
    (byte-vector->os-string b)))

;;; Preparing statements

(define (sqlite3-prepare-1 sqlite3 sql)
  (let* ((box (sqlite3-s48-box))
         (u-x (cons #f #f))
         (r   (sqlite3-s48-prepare-1 (sqlite3-box sqlite3)
                                     (os-string->byte-vector
                                      (x->os-string sql))
                                     #f ; utf-16?
                                     box u-x))
         (o   (make-sqlite3-prepared box #f)))
    (add-finalizer! o sqlite3-prepared-finalize-1!)
    ;; .
    (values r o (car u-x))))

(define (sqlite3-prepared-finalize-1! prepared)
  ;; .
  (cond ((sqlite3-prepared-box prepared)
         => (lambda (box)
              (let ((r (sqlite3-s48-finalize box)))
                ;; NB: statement is finalized irrespective of `r'
                (set-sqlite3-prepared-box! prepared #f)
                r)))))

(define (sqlite3-prepared-reset-1! prepared)
  (let ((r (sqlite3-s48-reset (sqlite3-prepared-box prepared))))
    ;; FIXME: should check `r' here?
    (set-sqlite3-prepared-finished?! prepared #f)
    ;; .
    r))

(define (sqlite3-prepared-step-1! prepared)
  (if (sqlite3-prepared-finished? prepared)
      (assertion-violation 'sqlite3-prepared-step-1!
                           "prepared statement already done"
                           prepared))
  (let ((r (sqlite3-s48-step  (sqlite3-prepared-box prepared))))
    (if (= r (sqlite3-result-code (sqlite3-result done)))
        (set-sqlite3-prepared-finished?! prepared #t))
    ;; .
    r))

(define sqlite3-prepare-2
  (make-call-ok-wrapper sqlite3-prepare-1
                        (lambda (r o index)
                          (values o index))
                        'sqlite3-prepare-2
                        "sqlite3-s48-prepare-1 failed"))

(define (sqlite3-prepare sqlite3 sql)
  (call-with-values (lambda () (sqlite3-prepare-2 sqlite3 sql))
    (lambda (prepared index)
      prepared)))

(define sqlite3-prepared-finalize!
  (make-call-ok-wrapper sqlite3-prepared-finalize-1!
                        (lambda (r) (unspecific))
                        'sqlite3-prepared-finalize!
                        "sqlite3-s48-finalize failed"))

(define sqlite3-prepared-reset!
  (make-call-ok-wrapper sqlite3-prepared-reset-1!
                        (lambda (r) (unspecific))
                        'sqlite3-prepared-reset!
                        "sqlite3-s48-reset failed"))

(define sqlite3-prepared-step!
  (let ((row-code  (sqlite3-result-code (sqlite3-result row)))
        (done-code (sqlite3-result-code (sqlite3-result done))))
    (make-call-wrapper sqlite3-prepared-step-1!
                       (lambda (signal r)
                         (cond ((= r row-code)  #t)
                               ((= r done-code) #f)
                               (else
                                (signal "sqlite3-s48-reset failed"))))
                       'sqlite3-prepared-step!)))

;;; Fetching values

(define (sqlite3-columns prepared)
  ;; .
  (sqlite3-s48-data-count (sqlite3-prepared-box prepared)))

(define (check-index prepared index)
  (if (or (negative? index)
          (>= index (sqlite3-columns prepared)))
      (assertion-violation 'sqlite3-column-type
                           "column index out of range"
                           index)))

(define (sqlite3-column-type-1 prepared index)
  (check-index prepared index)
  ;; .
  (sqlite3-s48-column-type  (sqlite3-prepared-box prepared)
                            index))

(define (sqlite3-column-type prepared index)
  ;; .
  (sqlite3-type<-integer (sqlite3-column-type-1 prepared index)))

(define (sqlite3-column-name-1 prepared index)
  (check-index prepared index)
  ;; .
  (sqlite3-s48-column-name  (sqlite3-prepared-box prepared)
                            index))

(define (sqlite3-column-name prepared index)
  ;; .
  (x->os-string (sqlite3-column-name-1 prepared index)))

(define (sqlite3-column-blob prepared index)
  (check-index prepared index)
  ;; .
  (sqlite3-s48-column-blob  (sqlite3-prepared-box prepared)
                            index))

;;; Executing queries

(define (sqlite3-exec sqlite3 sql callback cb-data)
  (let ((prepared (sqlite3-prepare sqlite3 sql)))
    (let loop ()
      (if (sqlite3-prepared-step! prepared)
          (let ((columns (sqlite3-columns prepared)))
            (do ((i     (+ -1 columns) (+ -1 i))
                 (vals  (make-vector columns))
                 (names (make-vector columns)))
                ((negative? i)
                 (callback cb-data columns vals names))
              ;; FIXME: should x->os-string be applied here?
              (vector-set! vals  i (sqlite3-column-blob prepared i))
              (vector-set! names i (sqlite3-column-name prepared i)))
            (loop))))))

;;; sqlite3.scm ends here

;;; "sqlite3-packages.scm" -- ???  -*- Scheme -*-

;;; Copyright (C) 2008 Ivan Shmakov

;;; Code:

(define-interface sqlite3-interface
  (export sqlite3?
          sqlite3-prepared?
          sqlite3-libversion
          sqlite3-libversion-list
          sqlite3-open
          sqlite3-close
          sqlite3-last-result
          sqlite3-last-error-message
          sqlite3-prepare
          sqlite3-prepare-2
          sqlite3-prepared-finalize!
          sqlite3-prepared-reset!
          sqlite3-prepared-step!
          sqlite3-prepared-finished?
          sqlite3-columns
          sqlite3-column-type
          sqlite3-column-name
          sqlite3-column-blob
          sqlite3-exec))

(define-interface sqlite3-low-interface
  (export (sqlite3-result :syntax)
          sqlite3-result-code
          sqlite3-result-name
          sqlite3-libversion-number
          sqlite3-open-1
          sqlite3-close-1
          sqlite3-prepare-1
          sqlite3-prepared-finalize-1!
          sqlite3-prepared-reset-1!
          sqlite3-prepared-step-1!
          sqlite3-column-type-1
          sqlite3-column-name-1
          sqlite3-exec-1))

(define-interface chicken-sqlite3-interface
  (export sqlite3:open
          sqlite3:close
          sqlite3:exec
          sqlite3:first-result
          sqlite3:first-row
          sqlite3:for-each-row
          sqlite3:map-row))

(define-structures ((sqlite3            sqlite3-interface)
                    (sqlite3-low        sqlite3-low-interface))
  (open scheme
        ;; exceptions
        (subset exceptions
                (assertion-violation))
        ;; externals
        external-calls
        load-dynamic-externals
        ;; data structures
        (subset util (unspecific))
        byte-vectors
        define-record-types
        finite-types
        os-strings)
  (files sqlite3))

;;; sqlite3-packages.scm ends here

/*** sqlite3-int.c --- ?  -*- C -*- */

/*** Copyright (C) 2008 Ivan Shmakov */

/*** Code: */

#include <stddef.h>             /* for size_t */

#include <scheme48.h>

#include <sqlite3.h>

typedef s48_call_t  x48_call;
typedef s48_ref_t   x48_ref;

static x48_ref   sqlite3_s48_box (x48_call);

static x48_ref   sqlite3_s48_libversion (x48_call);
static x48_ref   sqlite3_s48_libversion_number (x48_call);

static x48_ref   sqlite3_s48_free (x48_call, x48_ref);

static x48_ref   sqlite3_s48_open   (x48_call, x48_ref, x48_ref);
static x48_ref   sqlite3_s48_open16 (x48_call, x48_ref, x48_ref);
static x48_ref   sqlite3_s48_close (x48_call, x48_ref);

static x48_ref   sqlite3_s48_errcode (x48_call, x48_ref sqlite3_ptr);
static x48_ref   sqlite3_s48_errmsg  (x48_call, x48_ref sqlite3_ptr);

static x48_ref   sqlite3_s48_prepare_1 (x48_call,
                                        x48_ref, x48_ref, x48_ref,
                                        x48_ref, x48_ref);
static x48_ref   sqlite3_s48_finalize (x48_call, x48_ref);
static x48_ref   sqlite3_s48_reset (x48_call, x48_ref);
static x48_ref   sqlite3_s48_step (x48_call, x48_ref);

static x48_ref   sqlite3_s48_data_count (x48_call, x48_ref);
static x48_ref   sqlite3_s48_column_type (x48_call, x48_ref, x48_ref);
static x48_ref   sqlite3_s48_column_name (x48_call, x48_ref, x48_ref);
static x48_ref   sqlite3_s48_column_blob (x48_call, x48_ref, x48_ref);

void
s48_on_load (void)
{
  S48_EXPORT_FUNCTION (sqlite3_s48_box);

  S48_EXPORT_FUNCTION (sqlite3_s48_libversion);
  S48_EXPORT_FUNCTION (sqlite3_s48_libversion_number);

  S48_EXPORT_FUNCTION (sqlite3_s48_free);

  S48_EXPORT_FUNCTION (sqlite3_s48_open);
  S48_EXPORT_FUNCTION (sqlite3_s48_open16);
  S48_EXPORT_FUNCTION (sqlite3_s48_close);

  S48_EXPORT_FUNCTION (sqlite3_s48_errcode);
  S48_EXPORT_FUNCTION (sqlite3_s48_errmsg);

  S48_EXPORT_FUNCTION (sqlite3_s48_prepare_1);
  S48_EXPORT_FUNCTION (sqlite3_s48_finalize);
  S48_EXPORT_FUNCTION (sqlite3_s48_reset);
  S48_EXPORT_FUNCTION (sqlite3_s48_step);

  S48_EXPORT_FUNCTION (sqlite3_s48_data_count);
  S48_EXPORT_FUNCTION (sqlite3_s48_column_type);
  S48_EXPORT_FUNCTION (sqlite3_s48_column_name);
  S48_EXPORT_FUNCTION (sqlite3_s48_column_blob);

  /* . */
}

static x48_ref
sqlite3_s48_box (x48_call c)
{
  /* NB: it's assumed that sizeof (ANY_TYPE *) is the same */
  /* . */
  return s48_enter_pointer_2 (c, (void *)0);
}

static x48_ref
sqlite3_s48_libversion (x48_call c)
{
  /* . */
  return
    s48_enter_byte_string_2 (c, sqlite3_libversion ());
}

static x48_ref
sqlite3_s48_libversion_number (x48_call c)
{
  /* . */
  return
    s48_enter_long_2 (c, sqlite3_libversion_number ());
}

static x48_ref
sqlite3_s48_free (x48_call c, x48_ref ptr)
{
  sqlite3_free (s48_extract_value_2 (c, ptr, void *));
  /* . */
  return s48_unspecific_2 (c);
}

/*** Opening and closing database */

static x48_ref
sqlite3_s48_open (x48_call c, x48_ref filename, x48_ref sqlite3_ptr)
{
  /* NB: is filename expected to be in UTF-8? */
  const void *c_filename = s48_extract_byte_vector_2 (c, filename);
  sqlite3 *o;
  int r;

  r = sqlite3_open (c_filename, &o);
  s48_unsafe_set_value_2 (c, sqlite3_ptr, sqlite3 *, o);

  /* . */
  return
    s48_enter_long_2 (c, r);
}

static x48_ref
sqlite3_s48_open16 (x48_call c, x48_ref filename, x48_ref sqlite3_ptr)
{
  /* NB: filename is expected to be in UTF-16 */
  const void *c_filename = s48_extract_byte_vector_2 (c, filename);
  sqlite3 *o;
  int r;

  r = sqlite3_open16 (c_filename, &o);
  s48_unsafe_set_value_2 (c, sqlite3_ptr, sqlite3 *, o);

  /* . */
  return
    s48_enter_long_2 (c, r);
}

static x48_ref
sqlite3_s48_close (x48_call c, x48_ref sqlite3_ptr)
{
  sqlite3 *o = s48_unsafe_extract_value_2 (c, sqlite3_ptr, sqlite3 *);

  /* . */
  return
    s48_enter_long_2 (c, sqlite3_close (o));
}

/*** Database status */

static x48_ref
sqlite3_s48_errcode (x48_call c, x48_ref sqlite3_ptr)
{
  sqlite3 *o = s48_unsafe_extract_value_2 (c, sqlite3_ptr, sqlite3 *);

  /* . */
  return
    s48_enter_long_2 (c, sqlite3_errcode (o));
}

static x48_ref
sqlite3_s48_errmsg (x48_call c, x48_ref sqlite3_ptr)
{
  sqlite3 *o = s48_unsafe_extract_value_2 (c, sqlite3_ptr, sqlite3 *);

  /* . */
  return
    s48_enter_byte_string_2 (c, sqlite3_errmsg (o));
}

/*** Preparing statements */

static x48_ref
sqlite3_s48_prepare_1 (x48_call c,
                       x48_ref  sqlite3_ptr,
                       x48_ref  sql,
                       x48_ref  utf_16_p,
                       x48_ref  prepared_ptr,
                       x48_ref  used_pair)
{
  sqlite3 *o = s48_unsafe_extract_value_2 (c, sqlite3_ptr, sqlite3 *);
  const char *c_sql = s48_extract_byte_vector_2 (c, sql);
  const char *c_sql_tail;
  const size_t c_sql_size = s48_byte_vector_length_2 (c, sql);
  sqlite3_stmt *prepared;
  int r;

  s48_check_pair_2 (c, used_pair);

  r = (s48_extract_boolean_2 (c, utf_16_p)
       ? sqlite3_prepare16 (o, c_sql, c_sql_size,
                            &prepared, (const void **)&c_sql_tail)
       : sqlite3_prepare   (o, c_sql, c_sql_size,
                            &prepared, (const char **)&c_sql_tail));
  s48_unsafe_set_value_2 (c, prepared_ptr, sqlite3_stmt *, prepared);
  if (s48_pair_p_2 (c, used_pair)) {
    s48_unsafe_set_car_2 (c, used_pair,
                          s48_enter_long_2 (c, c_sql_tail - c_sql));
  }

  /* . */
  return
    s48_enter_long_2 (c, r);
}

static x48_ref
sqlite3_s48_finalize (x48_call c, x48_ref prepared_ptr)
{
  sqlite3_stmt *p
    = s48_unsafe_extract_value_2 (c, prepared_ptr, sqlite3_stmt *);

  /* . */
  return
    s48_enter_long_2 (c, sqlite3_finalize (p));
}

static x48_ref
sqlite3_s48_reset (x48_call c, x48_ref prepared_ptr)
{
  sqlite3_stmt *p
    = s48_unsafe_extract_value_2 (c, prepared_ptr, sqlite3_stmt *);

  /* . */
  return
    s48_enter_long_2 (c, sqlite3_reset (p));
}

static x48_ref
sqlite3_s48_step (x48_call c, x48_ref prepared_ptr)
{
  sqlite3_stmt *p
    = s48_unsafe_extract_value_2 (c, prepared_ptr, sqlite3_stmt *);

  /* . */
  return
    s48_enter_long_2 (c, sqlite3_step (p));
}

/*** Fetching values */

static x48_ref
sqlite3_s48_data_count (x48_call c, x48_ref prepared_ptr)
{
  sqlite3_stmt *p
    = s48_unsafe_extract_value_2 (c, prepared_ptr, sqlite3_stmt *);

  /* . */
  return
    s48_enter_long_2 (c, sqlite3_data_count (p));
}

static x48_ref
sqlite3_s48_column_type (x48_call c,
                         x48_ref prepared_ptr, x48_ref column)
{
  sqlite3_stmt *p
    = s48_unsafe_extract_value_2 (c, prepared_ptr, sqlite3_stmt *);
  int i = s48_extract_long_2 (c, column);

  /* . */
  return
    s48_enter_long_2 (c, sqlite3_column_type (p, i));
}

static x48_ref
sqlite3_s48_column_name (x48_call c,
                         x48_ref prepared_ptr, x48_ref column)
{
  sqlite3_stmt *p
    = s48_unsafe_extract_value_2 (c, prepared_ptr, sqlite3_stmt *);
  int i = s48_extract_long_2 (c, column);

  /* . */
  return
    s48_enter_byte_string_2 (c, sqlite3_column_name (p, i));
}

static x48_ref
sqlite3_s48_column_blob (x48_call c,
                         x48_ref prepared_ptr, x48_ref column)
{
  sqlite3_stmt *p
    = s48_unsafe_extract_value_2 (c, prepared_ptr, sqlite3_stmt *);
  int i = s48_extract_long_2 (c, column);
  int         l = sqlite3_column_bytes (p, i);
  const void *b = sqlite3_column_blob  (p, i);
  x48_ref v;

  v = s48_enter_byte_vector_2 (c, b, l);

  /* . */
  return v;
}

/*** sqlite3-int.c ends here */

### Makefile  -*- Makefile -*-
CFLAGS    = -g -Wall
CPPFLAGS  = -I$(HOME)/include
LDFLAGS   = -lsqlite3
SHARED_LDFLAGS = -shared $(LDFLAGS)

default: sqlite3-int.so

sqlite3-int.so: sqlite3-int.o
        $(CC) $(CFLAGS) -o $@ $^ $(SHARED_LDFLAGS)
### Makefile ends here