[MLton-commit] r5191
Wesley Terpstra
wesley at mlton.org
Wed Feb 14 07:33:12 PST 2007
rename things in preparation of callback methods and query pools
----------------------------------------------------------------------
U mltonlib/trunk/ca/terpstra/sqlite3/demo.sml
U mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
U mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
A mltonlib/trunk/ca/terpstra/sqlite3/query.sml
U mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
U mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
U mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
D mltonlib/trunk/ca/terpstra/sqlite3/template.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/ca/terpstra/sqlite3/demo.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/demo.sml 2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/demo.sml 2007-02-14 15:33:12 UTC (rev 5191)
@@ -11,15 +11,15 @@
val db = SQL.openDB dbname handle SQL.Error x => die x
local
- open SQL.Template
+ open SQL.Query
in
- val Q1 = query db "select x, y from peanuts\n\
- \where y="iI" or x="iS";" oS oI $
+ val Q1 = prepare db "select x, y from peanuts\n\
+ \where y="iI" or x="iS";" oS oI $
handle SQL.Error x => die x
end
fun dump (s & i) = print (s ^ " " ^ Int.toString i ^ "\n")
val a = SQL.app dump Q1 (arg & "hi") handle SQL.Error x => die x
-val () = SQL.close Q1
+val () = SQL.Query.close Q1
val () = SQL.closeDB db
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-14 15:33:12 UTC (rev 5191)
@@ -21,6 +21,8 @@
val step: query -> bool
val clearbindings: query -> unit
+ val query_string: query -> string
+
datatype storage = INTEGER of Int64.int
| REAL of real
| STRING of string
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-14 15:33:12 UTC (rev 5191)
@@ -50,6 +50,7 @@
(* we don't support any of the hooks, or user completion stuff yet *)
val Pdb_handle = _import "sqlite3_db_handle" : MLton.Pointer.t -> MLton.Pointer.t;
+ val Pquery_string = _import "sqlite3_query_string" : MLton.Pointer.t -> MLton.Pointer.t;
(* expiry should just raise an exception... *)
@@ -138,6 +139,8 @@
| r => (wrap (q, r); raise Error "unreachable")
fun clearbindings q = wrap (q, Pclearbindings q)
+ fun query_string q = valOf (cstr (Pquery_string q))
+
datatype storage = INTEGER of Int64.int
| REAL of real
| STRING of string (* WideString.string? *)
Copied: mltonlib/trunk/ca/terpstra/sqlite3/query.sml (from rev 5176, mltonlib/trunk/ca/terpstra/sqlite3/template.sml)
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/template.sml 2007-02-12 19:09:13 UTC (rev 5176)
+++ mltonlib/trunk/ca/terpstra/sqlite3/query.sml 2007-02-14 15:33:12 UTC (rev 5191)
@@ -0,0 +1,80 @@
+structure Query =
+ struct
+ (* Cry ... *)
+ type 'a oF = Prim.query -> 'a
+ type ('b, 'c) oN = Prim.query * (unit -> 'b) -> 'c
+ 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
+
+(*
+ type ('i, 'o) t = { Word8Vector.vector,
+ pool: Prim.query list ref,
+ used: int ref,
+ iF: Prim.query * 'i -> unit,
+ oF: Prim.query -> 'o }
+*)
+ type ('i, 'o) t = Prim.query * (Prim.query * 'i -> unit) * (Prim.query -> 'o)
+
+ fun oF0 _ = ()
+ fun oN0 (q, n) = n ()
+ val oI0 = 0
+ fun iF0 (q, ()) = ()
+ fun iN0 (q, x) = (1, x)
+
+ fun prepare 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 close (q, _, _) = Prim.finalize q
+
+ 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
+ fun iZ z = iMap Prim.bindZ z
+ fun iS z = iMap Prim.bindS z
+ fun iX z = iMap Prim.bindX z
+
+ 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, 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
+ fun oZ z = oMap Prim.fetchZ z
+ fun oS z = oMap Prim.fetchS z
+ fun oX z = oMap Prim.fetchX z
+
+ 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, 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
+ end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-14 15:33:12 UTC (rev 5191)
@@ -1,69 +1,30 @@
-(*
- *)
-
signature SQL =
sig
type db
- type ('i, 'o) query
type column = { name: string }
- exception Retry of string
- exception Abort of string
- exception Error 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
-
- (* For every 'query' you must eventually run this: *)
- val close: ('i, 'o) query -> unit
-
- (* Meta-data about the columns in the output *)
- val columns: ('i, 'o) query -> column vector
-
- (* 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
-
+ (* For unconverted type values *)
datatype storage = INTEGER of Int64.int
| REAL of real
| STRING of string
| BLOB of Word8Vector.vector
| NULL
- (* You should ignore the type information here. It's confusing and useless.
+ (* You should ignore the type information here. It's confusing & useless.
* Use this structure as follows:
* local
- * open SQL.Template
+ * open SQL.Query
* in
- * 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);" $
+ * val Q1 = prepare db "select (a, b) from table 1where x="iI" and y="iS";" oS oR $
+ * val Q2 = prepare db "insert into table2 values (4, 6);" $
* end
* ...
* val () = SQL.app (fn (x & y) => ...) Q1 (1 & "arg2")
* val () = SQL.exec Q2 ()
- * val () = SQL.close Q1
- * val () = SQL.close Q2
+ * val () = SQL.Query.close Q1
+ * val () = SQL.Query.close Q2
*)
- structure Template :
+ structure Query :
sig
type ('i, 'o, 'w, 'x, 'y, 'z) acc
type ('v, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output =
@@ -75,11 +36,15 @@
('j, 'o, 'a, 'b, ('j, 'k) pair, 'k) acc,
'x, 'y, 'z) Fold.step1
- val query: db -> string -> ((unit, unit, 'a, 'a, 'b, 'b) acc,
- ('i, 'o, 'c, 'd, 'e, 'f) acc,
- ('i, 'o) query, 'g) Fold.t
+ type ('i, 'o) t
+ val prepare: db -> string -> ((unit, unit, 'a, 'a, 'b, 'b) acc,
+ ('i, 'o, 'c, 'd, 'e, 'f) acc,
+ ('i, 'o) t, 'g) Fold.t
val $ : 'a * ('a -> 'b) -> 'b
+ (* For every 'query' you must eventually run this: *)
+ val close: ('i, 'o) t -> unit
+
(* Convert the next column to the desired type *)
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
@@ -104,4 +69,39 @@
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
+
+ exception Retry of string
+ exception Abort of string
+ exception Error 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
+
+ (* Meta-data about the columns in the output *)
+ val columns: ('i, 'o) Query.t -> column vector
+
+ (* Transform a query into an iterator *)
+ val iter: ('i, 'o) Query.t -> 'i -> unit -> 'o option
+
+ (* Run a function on each output row from a query *)
+ val map: ('o -> 'v) -> ('i, 'o) Query.t -> 'i -> 'v vector
+ val app: ('o -> unit) -> ('i, 'o) Query.t -> 'i -> unit
+
+ (* Run a function on each output row, allowing premature completion *)
+ datatype 'v stop = STOP | CONTINUE of 'v
+ val mapStop: ('o -> 'v stop) -> ('i, 'o) Query.t -> 'i -> 'v vector
+ val appStop: ('o -> unit stop) -> ('i, 'o) Query.t -> 'i -> unit
+ val iterStop: ('i, 'o) Query.t -> 'i -> unit stop -> 'o option
+
+ (* Convenience functions that work with the identity *)
+ val table: ('i, 'o) Query.t -> 'i -> 'o vector
+ val exec: ('i, unit) Query.t -> 'i -> unit
+
+ (* For simple queries you only run once, use: *)
+ val simpleTable: db * string -> string vector vector
+ val simpleExec: db * string -> unit
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-14 15:33:12 UTC (rev 5191)
@@ -1,6 +1,5 @@
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
datatype storage = datatype Prim.storage
@@ -9,17 +8,18 @@
exception Abort = Prim.Abort
exception Error = Prim.Error
- structure Template = Template
+ structure Query = Query
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 iter (q, iF, oF) i =
+ datatype 'v stop = STOP | CONTINUE of 'v
+
+ fun iterStop (q, iF, oF) i =
let
val () = iF (q, i)
val ok = ref true
@@ -29,13 +29,12 @@
Prim.clearbindings q;
ok := false)
in
- fn () =>
- if not (!ok) then NONE else
- if Prim.step q then SOME (oF q) else (stop (); NONE)
+ fn STOP => (stop (); NONE)
+ | (CONTINUE ()) =>
+ if not (!ok) then NONE else
+ if Prim.step q then SOME (oF q) else (stop (); NONE)
end
- datatype 'v stop = STOP | CONTINUE of 'v
-
fun mapStop f (q, iF, oF) i =
let
val () = iF (q, i)
@@ -75,18 +74,31 @@
fun map f = mapStop (CONTINUE o f)
fun app f = appStop (CONTINUE o f)
+ fun iter q i =
+ let
+ val step = iterStop q i
+ in
+ fn () => step (CONTINUE ())
+ end
fun table q = map (fn x => x) q
fun exec q = app (fn () => ()) q
local
- open Template
+ open Query
in
- fun simple (db, qs) =
+ fun simpleTable (db, qs) =
let
- val Q = query db qs oAS $
+ val Q = prepare db qs oAS $
in
table Q () before close Q
end
+
+ fun simpleExec (db, qs) =
+ let
+ val Q = prepare db qs $
+ in
+ exec Q () before close Q
+ end
end
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb 2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb 2007-02-14 15:33:12 UTC (rev 5191)
@@ -16,7 +16,7 @@
pair.sml
sql.sig
local
- template.sml
+ query.sml
in
sql.sml
end
Deleted: mltonlib/trunk/ca/terpstra/sqlite3/template.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/template.sml 2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/template.sml 2007-02-14 15:33:12 UTC (rev 5191)
@@ -1,69 +0,0 @@
-structure Template =
- struct
- (* Cry ... *)
- type 'a oF = Prim.query -> 'a
- type ('b, 'c) oN = Prim.query * (unit -> 'b) -> 'c
- 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 (q, ()) = ()
- fun iN0 (q, x) = (1, x)
-
- 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 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
- fun iZ z = iMap Prim.bindZ z
- fun iS z = iMap Prim.bindS z
- fun iX z = iMap Prim.bindX z
-
- 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, 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
- fun oZ z = oMap Prim.fetchZ z
- fun oS z = oMap Prim.fetchS z
- fun oX z = oMap Prim.fetchX z
-
- 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, 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
- end
More information about the MLton-commit
mailing list