[db] Add SQLite bindings for SML/NJ

This adds an SML/NJ version of the SQLite library, usable by including
sqlite.cm. It ascribes to the same SQLITE signature as the MLton version.

db/sqlite/Makefile

@@ -0,0 +1,5 @@
+FFI-smlnj/ffi.cm: sqlite.h
+	ml-nlffigen -include ../library.sml -dir FFI-smlnj -cmfile ffi.cm $^
+
+clean:
+	rm -rf FFI-smlnj .cm

db/sqlite/library.sml

@@ -0,0 +1,25 @@
+(* The ML-NLFFI generated code depends on this structure. It dynamically loads
+   libsqlite3 on program startup, and provides hooks for the generated code
+   to look up functions.
+*)
+
+structure Library = struct
+  local
+    val libs = [ "libsqlite3.so", "libsqlite3.so.0", "libsqlite3.dylib" ]
+
+    fun tryLib nil = raise Fail ("could not load any of "
+                                 ^ (String.concatWith ", " libs))
+      | tryLib (lib :: rest) = DynLinkage.open_lib { name = lib, global = true,
+                                                    lazy = true }
+                               handle x => tryLib rest
+
+    val libHandle = tryLib libs
+
+  in  
+    fun libh sym = let
+        val symHandle = DynLinkage.lib_symbol (libHandle, sym)
+      in  
+        fn () => DynLinkage.addr symHandle
+      end
+  end
+end

db/sqlite/sqlite-smlnj.sml

@@ -0,0 +1,149 @@
+structure SQLite :> SQLITE = struct
+
+  type db_t = (ST_sqlite3.tag, C.rw) C.su_obj C.ptr'
+  type db = db_t option ref
+  type stmt_t = (ST_sqlite3_stmt.tag, C.rw) C.su_obj C.ptr'
+  type stmt = stmt_t option ref
+
+  datatype column_type = INTEGER | FLOAT | TEXT | BLOB | NULL
+                       | UNKNOWN of int
+
+  exception SQLiteClosed
+  exception SQLiteError of string * int * string
+
+  fun get (ref NONE) = raise SQLiteClosed
+    | get (ref (SOME dbptr)) = dbptr
+
+  val errmsg = ZString.toML' o F_sqlite3_errmsg.f' o get
+  val errcode = Int32.toInt o F_sqlite3_errcode.f' o get
+
+  fun opendb filename = let
+       val filename' = ZString.dupML' filename
+       val ptrcell = C.alloc' C.S.ptr 0w1
+       val res = F_sqlite3_open.f' (filename', ptrcell)
+       val ptr = C.Get.ptr' (C.Ptr.|*! ptrcell)
+     in 
+       C.free' filename';
+       C.free' ptrcell;
+       if C.Ptr.isNull' ptr
+         then raise SQLiteError ("sqlite3_open", Int32.toInt res, "")
+         else ref (SOME ptr)
+     end
+
+  fun close db = (
+        (F_sqlite3_close.f' (get db));
+        db := NONE
+      )
+
+  fun prepare (db, query) = let
+        val query' = ZString.dupML' query
+        val stmtcell = C.alloc' C.S.ptr 0w1
+        val res = F_sqlite3_prepare.f' (
+                    get db, query', Int32.fromInt (size query),
+                    stmtcell, C.Ptr.null');
+        val _ = C.free' query'
+        val ptr = C.Get.ptr' (C.Ptr.|*! stmtcell)
+      in
+        C.free' stmtcell;
+        if C.Ptr.isNull' ptr
+          then raise SQLiteError ("sqlite3_prepare",
+                                  Int32.toInt res, errmsg db)
+          else ref (SOME ptr)
+      end
+
+  val reset = ignore o F_sqlite3_reset.f' o get
+
+  fun finalize stmt = (
+        F_sqlite3_finalize.f' (get stmt);
+        stmt := NONE
+      )
+
+  val SQLITE_TRANSIENT : C.voidptr = C.U.i2p (C.Cvt.c_ulong (~(0w1)))
+
+  fun bind_blob (stmt : stmt, num, vec) = let
+        val v' = ZString.dupML' (Byte.bytesToString vec)
+      in
+        Int32.toInt (F_sqlite3_bind_blob.f'
+        (get stmt, Int32.fromInt num, C.Ptr.inject' v',
+         Int32.fromInt (Word8Vector.length vec), SQLITE_TRANSIENT))
+        before C.free' v'
+     end
+
+  fun bind_double (stmt, num, value) = Int32.toInt (
+        F_sqlite3_bind_double.f' (get stmt, Int32.fromInt num, value))
+
+
+  fun bind_int (stmt, num, value) = Int32.toInt (
+        F_sqlite3_bind_int.f' (get stmt, Int32.fromInt num, value))
+
+(*
+  fun bind_int64 (stmt, num, value) = Int32.toInt (
+        F_sqlite3_bind_int64.f' (get stmt, Int32.fromInt num, value))
+*)
+  fun bind_int64 _ = raise Fail "SML/NJ Int64 support is broken."
+
+  fun bind_null (stmt, num) = Int32.toInt (
+        F_sqlite3_bind_null.f' (get stmt, Int32.fromInt num))
+
+  fun bind_text (stmt : stmt, num, str) = let
+        val v' = ZString.dupML' str
+      in
+        Int32.toInt (F_sqlite3_bind_text.f'
+        (get stmt, Int32.fromInt num, v',
+         Int32.fromInt (size str), SQLITE_TRANSIENT))
+        before C.free' v'
+     end
+
+  fun step stmt = Int32.toInt (F_sqlite3_step.f' (get stmt))
+
+  val bytes = Int32.toInt o F_sqlite3_column_bytes.f'
+  val ctype = F_sqlite3_column_type.f'
+
+  val SQLITE_INTEGER : Int32.int = 1
+  val SQLITE_FLOAT : Int32.int = 2
+  val SQLITE_TEXT : Int32.int = 3
+  val SQLITE_BLOB : Int32.int = 4
+  val SQLITE_NULL : Int32.int = 5
+
+  fun read_bytes (p, n) = Word8Vector.tabulate (n,
+        fn i => Word8.fromLarge (Word32.toLarge (
+                  C.Get.uchar' (C.Ptr.sub' C.S.uchar (p, i)))))
+
+  fun column_blob (stmt, num) = let
+        val arg = (get stmt, Int32.fromInt num)
+        val f = F_sqlite3_column_blob.f'
+      in
+        if ctype arg = SQLITE_NULL
+        then NONE
+        else SOME (read_bytes (C.Ptr.cast' (f arg), bytes arg))
+      end
+
+  fun column_double (stmt, num) =
+        F_sqlite3_column_double.f' (get stmt, Int32.fromInt num)
+
+  fun column_int (stmt, num) =
+        F_sqlite3_column_int.f' (get stmt, Int32.fromInt num)
+(*
+  fun column_int64 (stmt, num) =
+        F_sqlite3_column_int64.f' (get stmt, Int32.fromInt num)
+*)
+  fun column_int64 _ = raise Fail "SML/NJ Int64 support is broken."
+
+  fun column_text (stmt, num) = let
+        val arg = (get stmt, Int32.fromInt num)
+        val f = F_sqlite3_column_text.f'
+      in
+        if ctype arg = SQLITE_NULL
+        then NONE
+        else SOME (Byte.bytesToString (read_bytes (f arg, bytes arg)))
+      end
+
+  fun column_type (stmt, num) = case ctype (get stmt, Int32.fromInt num) of
+        1 => INTEGER
+      | 2 => FLOAT
+      | 3 => TEXT
+      | 4 => BLOB
+      | 5 => NULL
+      | i => UNKNOWN (Int32.toInt i)
+
+end

db/sqlite/sqlite.cm

@@ -0,0 +1,9 @@
+Library
+	signature SQLITE
+	structure SQLite
+is
+	$/basis.cm
+	$c/c.cm
+	FFI-smlnj/ffi.cm : make ()
+	sqlite.sig
+	sqlite-smlnj.sml

db/sqlite/sqlite.h

@@ -0,0 +1,69 @@
+/* This is a standalone version of the real sqlite.h, since the real one
+   icludes system header files which use GCC extensions. Ick. */
+
+typedef unsigned long long sqlite3_uint64;
+typedef signed long long sqlite3_int64;
+
+typedef struct sqlite3 sqlite3;
+typedef struct sqlite3_stmt sqlite3_stmt;
+typedef struct sqlite3_value sqlite3_value;
+
+const char *sqlite3_errmsg(sqlite3*);
+int sqlite3_errcode(sqlite3 *db);
+int sqlite3_extended_errcode(sqlite3 *db);
+
+int sqlite3_open(
+  const char *filename,   /* Database filename (UTF-8) */
+  sqlite3 **ppDb          /* OUT: SQLite db handle */
+);
+
+int sqlite3_open_v2(
+  const char *filename,   /* Database filename (UTF-8) */
+  sqlite3 **ppDb,         /* OUT: SQLite db handle */
+  int flags,              /* Flags */
+  const char *zVfs        /* Name of VFS module to use */
+);
+
+int sqlite3_close(sqlite3 *);
+
+int sqlite3_prepare(
+  sqlite3 *db,            /* Database handle */
+  const char *zSql,       /* SQL statement, UTF-8 encoded */
+  int nByte,              /* Maximum length of zSql in bytes. */
+  sqlite3_stmt **ppStmt,  /* OUT: Statement handle */
+  const char **pzTail     /* OUT: Pointer to unused portion of zSql */
+);
+
+int sqlite3_prepare_v2(
+  sqlite3 *db,            /* Database handle */
+  const char *zSql,       /* SQL statement, UTF-8 encoded */
+  int nByte,              /* Maximum length of zSql in bytes. */
+  sqlite3_stmt **ppStmt,  /* OUT: Statement handle */
+  const char **pzTail     /* OUT: Pointer to unused portion of zSql */
+);
+
+int sqlite3_reset(sqlite3_stmt *pStmt);
+int sqlite3_finalize(sqlite3_stmt *pStmt);
+
+int sqlite3_bind_blob(sqlite3_stmt*, int, const void*, int n, void *);
+int sqlite3_bind_double(sqlite3_stmt*, int, double);
+int sqlite3_bind_int(sqlite3_stmt*, int, int);
+int sqlite3_bind_int64(sqlite3_stmt*, int, sqlite3_int64);
+int sqlite3_bind_null(sqlite3_stmt*, int);
+int sqlite3_bind_text(sqlite3_stmt*, int, const char*, int n, void *);
+int sqlite3_bind_text16(sqlite3_stmt*, int, const void*, int, void *);
+int sqlite3_bind_value(sqlite3_stmt*, int, const sqlite3_value*);
+int sqlite3_bind_zeroblob(sqlite3_stmt*, int, int n);
+
+int sqlite3_step(sqlite3_stmt*);
+
+const void *sqlite3_column_blob(sqlite3_stmt*, int iCol);
+int sqlite3_column_bytes(sqlite3_stmt*, int iCol);
+int sqlite3_column_bytes16(sqlite3_stmt*, int iCol);
+double sqlite3_column_double(sqlite3_stmt*, int iCol);
+int sqlite3_column_int(sqlite3_stmt*, int iCol);
+sqlite3_int64 sqlite3_column_int64(sqlite3_stmt*, int iCol);
+const unsigned char *sqlite3_column_text(sqlite3_stmt*, int iCol);
+const void *sqlite3_column_text16(sqlite3_stmt*, int iCol);
+int sqlite3_column_type(sqlite3_stmt*, int iCol);
+sqlite3_value *sqlite3_column_value(sqlite3_stmt*, int iCol);