[MLton-commit] r5176
Wesley Terpstra
wesley at mlton.org
Mon Feb 12 11:09:14 PST 2007
improved binding
----------------------------------------------------------------------
U mltonlib/trunk/ca/terpstra/sqlite3/demo.sml
U mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
U mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
U mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
U mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
U mltonlib/trunk/ca/terpstra/sqlite3/template.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/ca/terpstra/sqlite3/demo.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/demo.sml 2007-02-12 01:31:14 UTC (rev 5175)
+++ mltonlib/trunk/ca/terpstra/sqlite3/demo.sml 2007-02-12 19:09:13 UTC (rev 5176)
@@ -1,4 +1,4 @@
-open SQL.Template
+val () = print ("SQLite version: " ^ SQL.version ^ "\n")
fun die x = (
print ("Caught exception: " ^ x ^ "\n");
@@ -7,25 +7,19 @@
val (dbname, query) = case CommandLine.arguments () of
[x, y] => (x, y)
| _ => die "Expecting: <database name> <query>\n"
+val arg = valOf (Int.fromString query)
+val db = SQL.openDB dbname handle Fail x => die x
local
open SQL.Template
in
- (* query templates I might execute *)
- val T1 = query "select x, y from peanuts\n\
- \where y="iI" or x="iS";" oS oI $
+ val Q1 = query db "select x, y from peanuts\n\
+ \where y="iI" or x="iS";" oS oI $
+ handle Fail x => die x
end
-fun dump (q, a) = (
- Vector.app (fn x => print (#name x ^ " ")) (SQL.meta q);
- print "\n";
- Vector.app (fn (s & i) => print (s ^ " " ^ Int.toString i ^ "\n")) a
- )
+fun dump (s & i) = print (s ^ " " ^ Int.toString i ^ "\n")
+val a = SQL.app dump Q1 (arg & "hi") handle Fail x => die x
-val db = SQL.openDB dbname handle Fail x => die x
-val Q1 = T1 (db & valOf (Int.fromString query) & "hi") handle Fail x => die x
-val a = SQL.pull Q1 handle Fail x => die x
-val () = dump (Q1, a)
val () = SQL.close Q1
-
val () = SQL.closeDB db
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-12 01:31:14 UTC (rev 5175)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-12 19:09:13 UTC (rev 5176)
@@ -16,9 +16,10 @@
val closeDB: db -> unit
val prepare: db * string -> query
+ val finalize: query -> unit
val reset: query -> unit
- val finalize: query -> unit
val step: query -> bool
+ val clearbindings: query -> unit
datatype storage = INTEGER of Int64.int
| REAL of real
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-12 01:31:14 UTC (rev 5175)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-12 19:09:13 UTC (rev 5176)
@@ -18,6 +18,7 @@
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 Pclearbindings = _import "sqlite3_clear_bindings" : 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;
@@ -135,6 +136,7 @@
100 => true (* #define SQLITE_ROW 100 /* sqlite_step() has another row ready */ *)
| 101 => false (* #define SQLITE_DONE 101 /* sqlite_step() has finished executing */ *)
| r => (wrap (q, r); raise Fail "unreachable")
+ fun clearbindings q = wrap (q, Pclearbindings q)
datatype storage = INTEGER of Int64.int
| REAL of real
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-12 01:31:14 UTC (rev 5175)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-12 19:09:13 UTC (rev 5176)
@@ -1,27 +1,48 @@
+(*
+ *)
+
signature SQL =
sig
type db
- type 'a query
+ type ('i, 'o) query
type column = { name: string }
exception Retry of string
exception Abort of string
exception Fail of string
+ (* The version of SQLite3 bound *)
+ val version: string
+
+ (* Open and close databases -- all queries must be closed *)
val openDB: string -> db
val closeDB: db -> unit
- val close: 'a query -> unit
- val meta: 'a query -> column vector
+ (* For every 'query' you must eventually run this: *)
+ val close: ('i, 'o) query -> unit
- val step: 'a query -> 'a option
- val map: ('a -> 'b) -> 'a query -> 'b vector
- val app: ('a -> unit) -> 'a query -> unit
+ (* Meta-data about the columns in the output *)
+ val columns: ('i, 'o) query -> column vector
- (* convenience functions *)
- val pull: 'a query -> 'a vector
- val exec: unit query -> unit
+ (* Transform a query into an iterator *)
+ val iter: ('i, 'o) query -> 'i -> unit -> 'o option
+ (* Run a function on each output row from a query *)
+ val map: ('o -> 'v) -> ('i, 'o) query -> 'i -> 'v vector
+ val app: ('o -> unit) -> ('i, 'o) query -> 'i -> unit
+
+ (* Run a function on each output row, and allow premature completion *)
+ datatype 'v stop = STOP | CONTINUE of 'v
+ val mapStop: ('o -> 'v stop) -> ('i, 'o) query -> 'i -> 'v vector
+ val appStop: ('o -> unit stop) -> ('i, 'o) query -> 'i -> unit
+
+ (* Convenience functions that work with the identity *)
+ val table: ('i, 'o) query -> 'i -> 'o vector
+ val exec: ('i, unit) query -> 'i -> unit
+
+ (* For simple queries you only run once, use: *)
+ val simple: db * string -> string vector vector
+
datatype storage = INTEGER of Int64.int
| REAL of real
| STRING of string
@@ -33,47 +54,54 @@
* local
* open SQL.Template
* in
- * val T1 = query "select (a, b) from table 1where x="iI" and y="iS";" oS oR $
- * val T2 = query "insert into table2 values (4, 6);" $
+ * val Q1 = query db "select (a, b) from table 1where x="iI" and y="iS";" oS oR $
+ * val Q2 = query db "insert into table2 values (4, 6);" $
* end
* ...
- * val Q1 = T1 (db & 6 & "sdfs")
- * val Q2 = T2 db
- *
- * val () = SQL.app (fn (x & y) => ...) Q1
- * val () = SQL.exec Q2
+ * val () = SQL.app (fn (x & y) => ...) Q1 (1 & "arg2")
+ * val () = SQL.exec Q2 ()
+ * val () = SQL.close Q1
+ * val () = SQL.close Q2
*)
structure Template :
sig
- type ('i, 'o, 'x, 'y) acc
- type ('v, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output = (('i, 'o, 'v, 'x) acc, ('i, 'x, 'y, ('x, 'y) pair) acc, 'a, 'b, 'c) Fold.step0
- type ('v, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input = (string, ('i, 'o, 'x, 'y) acc, (('i, 'v) pair, 'o, 'x, 'y) acc, 'a, 'b, 'c) Fold.step1
+ type ('i, 'o, 'w, 'x, 'y, 'z) acc
+ type ('v, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output =
+ (('i, 'o, 'v, 'p, 'a, 'b) acc,
+ ('i, 'p, 'q, ('p, 'q) pair, 'a, 'b) acc,
+ 'x, 'y, 'z) Fold.step0
+ type ('v, 'i, 'o, 'j, 'k, 'a, 'b, 'x, 'y, 'z) input =
+ (string, ('i, 'o, 'a, 'b, 'j, 'v) acc,
+ ('j, 'o, 'a, 'b, ('j, 'k) pair, 'k) acc,
+ 'x, 'y, 'z) Fold.step1
- val query: string -> ((db, unit, 'a, 'a) acc, ('i, 'o, 'x, 'y) acc, 'i -> 'o query, 'z) Fold.t
+ val query: db -> string -> ((unit, unit, 'a, 'a, 'b, 'b) acc,
+ ('i, 'o, 'c, 'd, 'e, 'f) acc,
+ ('i, 'o) query, 'g) Fold.t
val $ : 'a * ('a -> 'b) -> 'b
(* Convert the next column to the desired type *)
- val oB: (Word8Vector.vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- val oR: (real, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- val oI: (int, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- val oZ: (Int64.int, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- val oS: (string, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- val oX: (storage, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oB: (Word8Vector.vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oR: (real, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oI: (int, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oZ: (Int64.int, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oS: (string, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oX: (storage, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
(* Convert all the columns to the desired type in a vector *)
- val oAB: (Word8Vector.vector vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- val oAR: (real vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- val oAI: (int vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- val oAZ: (Int64.int vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- val oAS: (string vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- val oAX: (storage vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oAB: (Word8Vector.vector vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oAR: (real vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oAI: (int vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oAZ: (Int64.int vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oAS: (string vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oAX: (storage vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
(* Use a variable of the named type in the SQL statement *)
- val iB: (Word8Vector.vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
- val iR: (real, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
- val iI: (int, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
- val iZ: (Int64.int, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
- val iS: (string, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
- val iX: (storage, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
+ val iB: (Word8Vector.vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) input
+ val iR: (real, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) input
+ val iI: (int, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) input
+ val iZ: (Int64.int, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) input
+ val iS: (string, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) input
+ val iX: (storage, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) input
end
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-12 01:31:14 UTC (rev 5175)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-12 19:09:13 UTC (rev 5176)
@@ -1,47 +1,92 @@
structure SQL :> SQL =
struct
+ type ('i, 'o) query = Prim.query * (Prim.query * 'i -> unit) * (Prim.query -> 'o)
+ type column = Prim.column
type db = Prim.db
- type 'a query = Prim.query * (Prim.query -> 'a)
- type column = Prim.column
+ datatype storage = datatype Prim.storage
exception Retry = Prim.Retry
exception Abort = Prim.Abort
exception Fail = Prim.Fail
- datatype storage = datatype Prim.storage
+ structure Template = Template
+
+ val version = Prim.version
+
+ fun close (q, _, _) = Prim.finalize q
+ fun columns (q, _, _) = Prim.meta q
+
val openDB = Prim.openDB
val closeDB = Prim.closeDB
- fun close (q, _) = Prim.finalize q
- fun meta (q, _) = Prim.meta q
+ fun iter (q, iF, oF) i =
+ let
+ val () = iF (q, i)
+ val ok = ref true
+
+ fun stop () = (
+ Prim.reset q;
+ Prim.clearbindings q;
+ ok := false)
+ in
+ fn () =>
+ if not (!ok) then NONE else
+ if Prim.step q then SOME (oF q) else (stop (); NONE)
+ end
- fun step (q, oF) =
- if Prim.step q
- then SOME (oF q)
- else (Prim.reset q; NONE)
+ datatype 'v stop = STOP | CONTINUE of 'v
- fun map f (q, oF) =
+ fun mapStop f (q, iF, oF) i =
let
+ val () = iF (q, i)
+
+ fun stop l = (
+ Prim.reset q;
+ Prim.clearbindings q;
+ Vector.fromList (List.rev l))
+
fun helper l =
if Prim.step q
- then helper (f (oF q) :: l)
- else (Prim.reset q; Vector.fromList (List.rev l))
+ then case f (oF q) of
+ STOP => stop l
+ | CONTINUE r => helper (r :: l)
+ else stop l
in
helper []
end
- fun app f (q, oF) =
+ fun appStop f (q, iF, oF) i =
let
+ val () = iF (q, i)
+
+ fun stop () = (
+ Prim.reset q;
+ Prim.clearbindings q)
+
fun helper () =
if Prim.step q
- then (f (oF q); helper ())
- else Prim.reset q
+ then case f (oF q) of
+ STOP => stop ()
+ | CONTINUE () => helper ()
+ else stop ()
in
helper ()
end
- fun pull q = map (fn x => x) q
- fun exec q = app (fn () => ()) q
+ fun map f = mapStop (CONTINUE o f)
+ fun app f = appStop (CONTINUE o f)
- structure Template = Template
+ fun table q = map (fn x => x) q
+ fun exec q = app (fn () => ()) q
+
+ local
+ open Template
+ in
+ fun simple (db, qs) =
+ let
+ val Q = query db qs oAS $
+ in
+ table Q () before close Q
+ end
+ end
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/template.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/template.sml 2007-02-12 01:31:14 UTC (rev 5175)
+++ mltonlib/trunk/ca/terpstra/sqlite3/template.sml 2007-02-12 19:09:13 UTC (rev 5176)
@@ -1,27 +1,42 @@
structure Template =
struct
+ (* Cry ... *)
type 'a oF = Prim.query -> 'a
type ('b, 'c) oN = Prim.query * (unit -> 'b) -> 'c
- type 'd iF = 'd * string -> Prim.query * int
- type ('i, 'o, 'x, 'y) acc = string list * 'o oF * ('x, 'y) oN * int * 'i iF
- type ('v, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output = (('i, 'o, 'v, 'x) acc, ('i, 'x, 'y, ('x, 'y) pair) acc, 'a, 'b, 'c) Fold.step0
- type ('v, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input = (string, ('i, 'o, 'x, 'y) acc, (('i, 'v) pair, 'o, 'x, 'y) acc, 'a, 'b, 'c) Fold.step1
+ type 'd iF = Prim.query * 'd -> unit
+ type ('e, 'f) iN = Prim.query * 'e -> int * 'f
+ type ('i, 'o, 'w, 'x, 'y, 'z) acc = string list * 'o oF * ('w, 'x) oN * int * 'i iF * ('y, 'z) iN
+ type ('v, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output =
+ (('i, 'o, 'v, 'p, 'a, 'b) acc,
+ ('i, 'p, 'q, ('p, 'q) pair, 'a, 'b) acc,
+ 'x, 'y, 'z) Fold.step0
+ type ('v, 'i, 'o, 'j, 'k, 'a, 'b, 'x, 'y, 'z) input =
+ (string, ('i, 'o, 'a, 'b, 'j, 'v) acc,
+ ('j, 'o, 'a, 'b, ('j, 'k) pair, 'k) acc,
+ 'x, 'y, 'z) Fold.step1
fun oF0 _ = ()
fun oN0 (q, n) = n ()
val oI0 = 0
- fun iF0 (db, qs) = (Prim.prepare (db, qs), 1)
+ fun iF0 (q, ()) = ()
+ fun iN0 (q, x) = (1, x)
- fun query qs = Fold.fold (([qs], oF0, oN0, oI0, iF0),
- fn (ql, oF, _, _, iF) =>
- let val qs = concat (rev ql)
- in fn arg =>
- case iF (arg, qs) of (q, _) => (q, oF)
- end)
+ fun query db qs = Fold.fold (([qs], oF0, oN0, oI0, iF0, iN0),
+ fn (ql, oF, _, oI, iF, _) =>
+ let val qs = concat (rev ql)
+ val q = Prim.prepare (db, qs)
+ in if Prim.cols q < oI
+ then (Prim.finalize q;
+ raise Fail "insufficient output columns")
+ else (q, iF, oF)
+ end)
+ (* terminate an expression with this: *)
+ val $ = $
- fun iFx f iF (a & x, qs) = case iF (a, qs) of (q, i) => (f (q, i, x); (q, i+1))
- fun iMap f = Fold.step1 (fn (qs, (ql, oF, oN, oI, iF)) =>
- (qs :: "?" :: ql, oF, oN, oI, iFx f iF))
+ fun iFx f iN (q, a) = case iN (q, a) of (i, x) => f (q, i, x)
+ fun iNx f iN (q, a & y) = case iN (q, a) of (i, x) => (f (q, i, x); (i+1, y))
+ fun iMap f = Fold.step1 (fn (qs, (ql, oF, oN, oI, iF, iN)) =>
+ (qs :: "?" :: ql, oF, oN, oI, iFx f iN, iNx f iN))
fun iB z = iMap Prim.bindB z
fun iR z = iMap Prim.bindR z
fun iI z = iMap Prim.bindI z
@@ -31,8 +46,8 @@
fun oFx f (oN, oI) q = oN (q, fn () => f (q, oI))
fun oNx f (oN, oI) (q, n) = oN (q, fn () => f (q, oI)) & n ()
- fun oMap f = Fold.step0 (fn (ql, oF, oN, oI, iF) =>
- (ql, oFx f (oN, oI), oNx f (oN, oI), oI+1, iF))
+ fun oMap f = Fold.step0 (fn (ql, oF, oN, oI, iF, iN) =>
+ (ql, oFx f (oN, oI), oNx f (oN, oI), oI+1, iF, iN))
fun oB z = oMap Prim.fetchB z
fun oR z = oMap Prim.fetchR z
fun oI z = oMap Prim.fetchI z
@@ -43,15 +58,12 @@
fun fetchA (q, m) = Vector.tabulate (Prim.cols q, fn i => m (q, i))
fun oFAx f oN q = oN (q, fn () => fetchA (q, f))
fun oNAx f oN (q, n) = oN (q, fn () => fetchA (q, f)) & n ()
- fun oMapA f = Fold.step0 (fn (ql, oF, oN, oI, iF) =>
- (ql, oFAx f oN, oNAx f oN, oI, iF))
+ fun oMapA f = Fold.step0 (fn (ql, oF, oN, oI, iF, iN) =>
+ (ql, oFAx f oN, oNAx f oN, oI, iF, iN))
fun oAB z = oMapA Prim.fetchB z
fun oAR z = oMapA Prim.fetchR z
fun oAI z = oMapA Prim.fetchI z
fun oAZ z = oMapA Prim.fetchZ z
fun oAS z = oMapA Prim.fetchS z
fun oAX z = oMapA Prim.fetchX z
-
- (* terminate an execution with this: *)
- val $ = $
end
More information about the MLton-commit
mailing list