[MLton-commit] r5147
Wesley Terpstra
wesley at mlton.org
Tue Feb 6 09:02:07 PST 2007
more sensible interface
----------------------------------------------------------------------
A mltonlib/trunk/ca/terpstra/sqlite3/debug.sml
U mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
U mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
U mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
U mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
----------------------------------------------------------------------
Added: mltonlib/trunk/ca/terpstra/sqlite3/debug.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/debug.sml 2007-02-06 16:20:02 UTC (rev 5146)
+++ mltonlib/trunk/ca/terpstra/sqlite3/debug.sml 2007-02-06 17:01:55 UTC (rev 5147)
@@ -0,0 +1,63 @@
+functor PrimDebug(P : PRIM) : PRIM =
+ struct
+ open P
+
+ fun wrap (f, s) x = (print (s ^ "\n"); f x)
+
+ fun openDB f = wrap (P.openDB, "openDB: " ^ f) f
+ val closeDB = wrap (P.closeDB, "closeDB")
+
+ val prepare = fn (d, q) => wrap (P.prepare, "prepare: " ^ q) (d, q)
+ val reset = wrap (P.reset, "reset")
+ val finalize = wrap (P.finalize, "finalize")
+ val step = wrap (P.step, "step")
+
+ fun bindings q =
+ let val () = print "bindings: "
+ val r = P.bindings q
+ val () = print (Int.toString r ^ "\n")
+ in r end
+
+ fun bindWrap (s, p, f) (q, i, x) = (
+ print (s ^ " " ^ Int.toString i ^ ": " ^ f x ^ "\n");
+ p (q, i, x))
+ val bindB = bindWrap ("bindB", P.bindB, Int.toString o Word8Vector.length)
+ val bindR = bindWrap ("bindR", P.bindR, Real.toString)
+ val bindI = bindWrap ("bindI", P.bindI, Int.toString)
+ val bindZ = bindWrap ("bindZ", P.bindZ, Int64.toString)
+ val bindS = bindWrap ("bindS", P.bindS, fn x => x)
+ fun bindN (q, i) = print ("bindN " ^ Int.toString i ^ ": NULL\n")
+ fun bindX (q, i, INTEGER z) = (print "bindX: "; bindZ (q, i, z))
+ | bindX (q, i, REAL r) = (print "bindX: "; bindR (q, i, r))
+ | bindX (q, i, STRING s) = (print "bindX: "; bindS (q, i, s))
+ | bindX (q, i, BLOB b) = (print "bindX: "; bindB (q, i, b))
+ | bindX (q, i, NULL) = (print "bindX: "; bindN (q, i))
+
+ fun cols q =
+ let val () = print "cols: "
+ val r = P.cols q
+ val () = print (Int.toString r ^ "\n")
+ in r end
+
+ fun fetchWrap (s, p, f) (q, i) =
+ let val () = print (s ^ " " ^ Int.toString i ^ ": ")
+ val r = p (q, i)
+ val () = print (f r ^ "\n")
+ in r end
+ val fetchB = fetchWrap ("fetchB", P.fetchB, Int.toString o Word8Vector.length)
+ val fetchR = fetchWrap ("fetchR", P.fetchR, Real.toString)
+ val fetchI = fetchWrap ("fetchI", P.fetchI, Int.toString)
+ val fetchZ = fetchWrap ("fetchZ", P.fetchZ, Int64.toString)
+ val fetchS = fetchWrap ("fetchS", P.fetchS, fn x => x)
+ fun fetchN (q, i) = print ("fetchN " ^ Int.toString i ^ ": NULL\n")
+ val fetchX = fetchWrap ("fetchX", P.fetchX,
+ fn (INTEGER z) => Int64.toString z
+ | (REAL r) => Real.toString r
+ | (STRING s) => s
+ | (BLOB b) => Int.toString (Word8Vector.length b)
+ | NULL => "(NULL)")
+
+ val meta = wrap (P.meta, "meta")
+ end
+
+structure Prim = PrimDebug(Prim)
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-06 16:20:02 UTC (rev 5146)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-06 17:01:55 UTC (rev 5147)
@@ -7,14 +7,16 @@
exception Abort of string (* transaction aborted *)
exception Fail of string (* database corrupt; close it *)
+ (* a side-benefit of this as a string is that it forces sqlite3 to be linked *)
val version: string
- (* All of these methods can raise an exception *)
+ (* All of these methods can raise an exception: *)
val openDB: string -> db
val closeDB: db -> unit
val prepare: db * string -> query
+ val reset: query -> unit
val finalize: query -> unit
val step: query -> bool
@@ -29,6 +31,7 @@
val bindR: query * int * real -> unit
val bindI: query * int * int -> unit
val bindZ: query * int * Int64.int -> unit
+ val bindN: query * int -> unit
val bindS: query * int * string -> unit
val bindX: query * int * storage -> unit
@@ -37,12 +40,20 @@
val fetchR: query * int -> real
val fetchI: query * int -> int
val fetchZ: query * int -> Int64.int
+ val fetchN: query * int -> unit
val fetchS: query * int -> string
val fetchX: query * int -> storage
- val databases: query -> string option vector
- val decltypes: query -> string option vector
- val tables: query -> string option vector
- val origins: query -> string option vector
- val names: query -> string vector
+ (* Every output column has a name.
+ * Depending on compile options of sqlite3, you might have more meta-data.
+ * We comment out the sections that must be enabled at sqlite3 compile-time.
+ *)
+ type column = { name: string }
+ (*
+ origin: { table: string,
+ db: string,
+ decl: string,
+ schema: string }
+ option } *)
+ val meta: query -> column vector
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-06 16:20:02 UTC (rev 5146)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-06 17:01:55 UTC (rev 5147)
@@ -17,7 +17,7 @@
val Pfinalize = _import "sqlite3_finalize" : MLton.Pointer.t -> int;
val Pprepare = _import "sqlite3_prepare_v2" : MLton.Pointer.t * string * int * MLton.Pointer.t ref * MLton.Pointer.t ref -> int;
val Pstep = _import "sqlite3_step" : MLton.Pointer.t -> int;
-(* val Preset = _import "sqlite3_reset" : MLton.Pointer.t -> int; *)
+ val Preset = _import "sqlite3_reset" : MLton.Pointer.t -> int;
val Pbind_blob = _import "sqlite3_bind_blob" : MLton.Pointer.t * int * Word8Vector.vector * int * word -> int;
val Pbind_double = _import "sqlite3_bind_double" : MLton.Pointer.t * int * real -> int;
@@ -52,7 +52,7 @@
(* expiry should just raise an exception... *)
- (* we don't support extended result codes; that would break datatypes *)
+ (* we don't support extended result codes; that would break the case statement *)
(* the exec & get_table methods are better reimplemented in SML *)
@@ -129,6 +129,7 @@
code (Pdb_handle q, r)
fun finalize q = wrap (q, Pfinalize q)
+ fun reset q = wrap (q, Preset q)
fun step q =
case (Pstep q) of
100 => true (* #define SQLITE_ROW 100 /* sqlite_step() has another row ready */ *)
@@ -168,6 +169,7 @@
fun fetchR (q, i) = Pcolumn_double (q, i)
fun fetchI (q, i) = Pcolumn_int (q, i)
fun fetchZ (q, i) = Pcolumn_int64 (q, i)
+ fun fetchN (q, i) = ()
fun fetchS (q, i) = valOf (cstr (Pcolumn_text (q, i)))
fun fetchX (q, i) =
@@ -179,10 +181,29 @@
| 5 => NULL
| _ => raise Fail "Invalid storage type"
- fun fetch (q, f) = Vector.tabulate (cols q, fn i => cstr (f (q, i)))
- fun databases q = fetch (q, Pcolumn_database_name)
- fun decltypes q = fetch (q, Pcolumn_decltype)
- fun tables q = fetch (q, Pcolumn_table_name)
- fun origins q = fetch (q, Pcolumn_origin_name)
- fun names q = Vector.tabulate (cols q, fn i => valOf (cstr (Pcolumn_name (q, i))))
+ type column = { name: string }
+(* origin: { table: string,
+ db: string,
+ decl: string,
+ schema: string }
+ option }
+*)
+ fun fetch (q, i) =
+ let
+ fun get f = valOf (cstr (f (q, i)))
+ val name = get Pcolumn_name
+ in
+ { name = name }
+(* usually not compiled into sqlite3:
+ case cstr (Pcolumn_decltype (q, i)) of
+ NONE => { name = name, origin = NONE }
+ | SOME decl =>
+ { name = name,
+ origin = SOME { table = get Pcolumn_table_name,
+ db = get Pcolumn_database_name,
+ decl = decl,
+ schema = get Pcolumn_origin_name } }
+*)
+ end
+ fun meta q = Vector.tabulate (cols q, fn i => fetch (q, i))
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-06 16:20:02 UTC (rev 5146)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-06 17:01:55 UTC (rev 5147)
@@ -1,6 +1,8 @@
structure SQL =
struct
type db = Prim.db
+ type ('a, 'b) query = Prim.query * ('a -> 'b)
+ type column = Prim.column
exception Retry = Prim.Retry
exception Abort = Prim.Abort
@@ -9,43 +11,21 @@
val openDB = Prim.openDB
val closeDB = Prim.closeDB
- fun outputEnds (_, _, f) = f ()
- fun inputEnds ((oF, db, q), _, b) () =
+ fun outputEnds (_, _, r) = r
+ fun inputEnds ((oF, db, q), _, b) =
let
val q = Prim.prepare (db, q)
val () = b q
- fun cancel () =
- Prim.finalize q
-
- fun step f =
- if Prim.step q
- then SOME (oF (q, 0, f))
- else (Prim.finalize q; NONE)
-
- fun app f =
- if Prim.step q
- then (oF (q, 0, f); app f)
- else Prim.finalize q
-
- fun map l f =
- if Prim.step q
- then map (oF (q, 0, f) :: l) f
- else (Prim.finalize q; Vector.fromList (List.rev l))
-
- fun meta () = {
- names = Prim.names q,
- databases = Prim.databases q,
- decltypes = Prim.decltypes q,
- tables = Prim.tables q,
- origins = Prim.origins q }
+ fun exec f = oF (q, 0, f)
in
- { step = step, app = app, map = map [], cancel = cancel, meta = meta }
+ (q, exec)
end
- fun execute db q =
+ fun query q =
Foldr.foldr (([], outputEnds, inputEnds),
- fn (ql, oF, iF) => iF ((oF, db, concat (q::ql)), 1, fn _ => ()))
+ fn (ql, oF, iF) => fn db =>
+ iF ((oF, db, concat (q::ql)), 1, fn _ => ()))
(* terminate an execution with this: *)
val $ = $
@@ -80,23 +60,31 @@
fun iS z = iMap Prim.bindS z
fun iX z = iMap Prim.bindX z
- fun i0 f () = f ()
- fun i1 f (a) = f a ()
- fun i2 f (a, b) = f a b ()
- fun i3 f (a, b, c) = f a b c ()
- fun i4 f (a, b, c, d) = f a b c d ()
- fun i5 f (a, b, c, d, e) = f a b c d e ()
+ val tuple0 = ()
+ fun tuple1 a = a
+ fun tuple2 a b = (a, b)
+ fun tuple3 a b c = (a, b, c)
+ fun tuple4 a b c d = (a, b, c, d)
+ fun tuple5 a b c d e = (a, b, c, d, e)
+ fun tuple6 a b c d e f = (a, b, c, d, e, f)
+ fun tuple7 a b c d e f g = (a, b, c, d, e, f, g)
+ fun tuple8 a b c d e f g h = (a, b, c, d, e, f, g, h)
- fun o0 f = f (fn () => ())
- fun o1 f = f (fn a => fn () => (a))
- fun o2 f = f (fn a => fn b => fn () => (a, b))
- fun o3 f = f (fn a => fn b => fn c => fn () => (a, b, c))
- fun o4 f = f (fn a => fn b => fn c => fn d => fn () => (a, b, c, d))
- fun o5 f = f (fn a => fn b => fn c => fn d => fn e => fn () => (a, b, c, d, e))
+ fun close (q, _) = Prim.finalize q
+ fun meta (q, _) = Prim.meta q
+
+ fun step f (q, exec) =
+ if Prim.step q
+ then SOME (exec f)
+ else (Prim.reset q; NONE)
+
+ fun map f (q, exec) =
+ let
+ fun helper l =
+ if Prim.step q
+ then helper (exec f :: l)
+ else (Prim.reset q; Vector.fromList (List.rev l))
+ in
+ helper []
+ end
end
-(*
-open SQL
-val db = Prim.openDB "test.db"
-val Q : real * string * int -> unit -> (string * string) option =
- o2 (i3 (execute db "select (a"oS", b"oS") from table where x="iR" and y="iS" and z="iI";" $))
-*)
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb 2007-02-06 16:20:02 UTC (rev 5146)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb 2007-02-06 17:01:55 UTC (rev 5147)
@@ -9,6 +9,7 @@
prim.sml
end
fold.sml
+(* debug.sml *)
in
sql.sml
end
More information about the MLton-commit
mailing list