[MLton-commit] r5229
Wesley Terpstra
wesley at mlton.org
Fri Feb 16 20:36:19 PST 2007
automaticly free queries. triggers MLton GC bug.
----------------------------------------------------------------------
U mltonlib/trunk/ca/terpstra/sqlite3/demo.mlb
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/query.sml
U mltonlib/trunk/ca/terpstra/sqlite3/ring.sig
U mltonlib/trunk/ca/terpstra/sqlite3/ring.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
----------------------------------------------------------------------
Modified: mltonlib/trunk/ca/terpstra/sqlite3/demo.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/demo.mlb 2007-02-17 04:25:10 UTC (rev 5228)
+++ mltonlib/trunk/ca/terpstra/sqlite3/demo.mlb 2007-02-17 04:36:18 UTC (rev 5229)
@@ -1,3 +1,4 @@
$(SML_LIB)/basis/basis.mlb
+$(SML_LIB)/basis/mlton.mlb
sqlite.mlb
demo.sml
Modified: mltonlib/trunk/ca/terpstra/sqlite3/demo.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/demo.sml 2007-02-17 04:25:10 UTC (rev 5228)
+++ mltonlib/trunk/ca/terpstra/sqlite3/demo.sml 2007-02-17 04:36:18 UTC (rev 5229)
@@ -41,6 +41,8 @@
val () = SQL.app dumpP Q1 (4 & "hi") handle SQL.Error x => die x
val () = SQL.app dumpV Q2 () handle SQL.Error x => die x
-val () = SQL.Query.close Q1 handle SQL.Error x => die x
-val () = SQL.Query.close Q2 handle SQL.Error x => die x
+val () = print ("Prepared queries: " ^ Int.toString (SQL.preparedQueries db) ^ "\n")
+val () = MLton.GC.collect ()
+val () = print ("Prepared queries: " ^ Int.toString (SQL.preparedQueries db) ^ "\n")
+
val () = SQL.closeDB db handle SQL.Error x => die x
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-17 04:25:10 UTC (rev 5228)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-17 04:36:18 UTC (rev 5229)
@@ -23,8 +23,6 @@
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-17 04:25:10 UTC (rev 5228)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-17 04:36:18 UTC (rev 5229)
@@ -52,7 +52,7 @@
val Pcolumn_table_name = _import "sqlite3_column_table_name" : Query.t * int -> CStr.out;
val Pdb_handle = _import "sqlite3_db_handle" : Query.t -> DB.t;
- val Pquery_string = _import "sqlite3_query_string" : Query.t -> CStr.out;
+(* val Pquery_string = _import "sqlite3_query_string" : Query.t -> CStr.out; *)
(* bind a user function *)
val Pcreate_function = _import "sqlite3_create_function" : DB.t * CStr.t * int * int * word * FnPtr.t * FnPtr.t * FnPtr.t -> int;
@@ -160,7 +160,7 @@
| r => (wrap (q, r); raise Error "unreachable; step wrapper should raise")
fun clearbindings q = wrap (q, Pclearbindings q)
- fun query_string q = valOf (CStr.toStringOpt (Pquery_string q))
+(* fun query_string q = valOf (CStr.toStringOpt (Pquery_string q)) *)
datatype storage = INTEGER of Int64.int
| REAL of real
Modified: mltonlib/trunk/ca/terpstra/sqlite3/query.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/query.sml 2007-02-17 04:25:10 UTC (rev 5228)
+++ mltonlib/trunk/ca/terpstra/sqlite3/query.sml 2007-02-17 04:36:18 UTC (rev 5229)
@@ -18,7 +18,7 @@
(* We need to be able to create new queries for recursive usage.
* Each prepared statement has only a single VM, so we need a factory
* to support reentrant processing. The used counter records how many
- * outstanding queries there are (-1 means closed). The pool saves
+ * outstanding queries there are (~1 means DB closed). The pool saves
* previously allocated prepared statements for quick re-use.
*)
@@ -27,26 +27,29 @@
available: Prim.query list ref,
used: int ref }
- type ('i, 'o) t = { pool: pool Ring.t,
+ type ('i, 'o) t = { pool: pool Ring.t MLton.Finalizable.t,
iF: Prim.query * 'i -> unit,
oF: Prim.query -> 'o }
- fun peek { pool, iF=_, oF=_ } =
- case Ring.get pool of { db, query, available, used } =>
- if !used = ~1 then raise Prim.Error "Query.t is closed" else
- case !available of
- x :: r => x
- | [] =>
- let
- val pq = Prim.prepare (db, query)
- val () = available := pq :: !available
- in
- pq
- end
+ fun accessPool (pool, f) =
+ MLton.Finalizable.withValue (pool, fn x => f (Ring.get x))
+ fun peek ({ pool, iF=_, oF=_ }, f) =
+ accessPool (pool, fn { db, query, available, used } =>
+ if !used = ~1 then raise Prim.Error "Database closed" else
+ case !available of
+ x :: r => f x
+ | [] =>
+ let
+ val pq = Prim.prepare (db, query)
+ val () = available := pq :: !available
+ in
+ f pq
+ end)
+
fun alloc ({ pool, iF, oF}, i) =
- case Ring.get pool of { db, query, available, used } =>
- if !used = ~1 then raise Prim.Error "Query.t is closed" else
+ accessPool (pool, fn { db, query, available, used } =>
+ if !used = ~1 then raise Prim.Error "Database closed" else
let
val pq = case !available of
[] => Prim.prepare (db, query)
@@ -55,50 +58,60 @@
val () = iF (pq, i)
in
(pq, oF)
- end
+ end)
fun release ({ pool, iF=_, oF=_ }, pq) =
- case Ring.get pool of { db=_, query=_, available, used } => (
- if !used = 0 then raise Prim.Error "wrapper bug: too many released statements" else
- Prim.reset pq;
- Prim.clearbindings pq;
- used := !used - 1;
- available := pq :: !available)
+ accessPool (pool, fn {db=_, query=_, available, used } =>
+ if !used = ~1 then raise Prim.Error "SQLite wrapper bug: cannot release closed query" else
+ if !used = 0 then raise Prim.Error "SQLite wrapper bug: too many releases" else
+ ( Prim.reset pq;
+ Prim.clearbindings pq;
+ used := !used - 1;
+ available := pq :: !available))
- (* We will rewrite this to closeAll soon *)
- fun close { pool, iF=_, oF=_ } =
- case Ring.get pool of { db=_, query=_, available, used } =>
- if !used = 0
- then (List.app Prim.finalize (!available);
- available := [];
- used := ~1)
- else raise Prim.Error "Query is being processed; cannot close"
-
fun oF0 _ = ()
fun oN0 (q, n) = n ()
val oI0 = 0
fun iF0 (q, ()) = ()
fun iN0 (q, x) = (1, x)
- fun prepare dbl qt =
- case Ring.get dbl of { db, query=_, available=_, used=_ } =>
- Fold.fold (([qt], 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 Prim.Error "insufficient output columns \
- \to satisfy prototype")
- else { pool = Ring.add ({ db = db,
- query = qs,
- available = ref [q],
- used = ref 0 }, dbl),
- iF = iF,
- oF = oF }
- end)
+ local
+ fun forceClose q = Prim.finalize q handle _ => ()
+ fun close l =
+ case Ring.get l of { db=_, query=_, available, used } =>
+ if !used <> 0 then raise Prim.Error "SQLite wrapper bug: finalizing in-use query" else
+ ( List.app forceClose (!available);
+ available := [];
+ used := ~1;
+ Ring.remove l
+ )
+ in
+ fun prepare dbl qt =
+ case Ring.get dbl of { db, query=_, available=_, used=_ } =>
+ Fold.fold (([qt], 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 Prim.Error "insufficient output columns\
+ \ to satisfy prototype")
+ else
+ let
+ val pool = MLton.Finalizable.new (
+ Ring.add ({ db = db,
+ query = qs,
+ available = ref [q],
+ used = ref 0 }, dbl))
+ val out = { pool = pool, iF = iF, oF = oF }
+ in
+ MLton.Finalizable.addFinalizer (pool, close);
+ out
+ end
+ end)
+ end
(* terminate an expression with this: *)
val $ = $
Modified: mltonlib/trunk/ca/terpstra/sqlite3/ring.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/ring.sig 2007-02-17 04:25:10 UTC (rev 5228)
+++ mltonlib/trunk/ca/terpstra/sqlite3/ring.sig 2007-02-17 04:36:18 UTC (rev 5229)
@@ -12,8 +12,10 @@
(* Remove a link from the ring, it is in a new ring *)
val remove: 'a t -> unit
- (* Run the method over all links in the ring *)
+ (* Run methods over all links in the ring *)
val fold: ('a * 'b -> 'b) -> 'b -> 'a t -> 'b
+ val app: ('a -> unit) -> 'a t -> unit
+ (* val map: ('a -> 'b) -> 'a t -> 'b t *)
(* Retrieve the value in this link *)
val get: 'a t -> 'a
Modified: mltonlib/trunk/ca/terpstra/sqlite3/ring.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/ring.sml 2007-02-17 04:25:10 UTC (rev 5228)
+++ mltonlib/trunk/ca/terpstra/sqlite3/ring.sml 2007-02-17 04:36:18 UTC (rev 5229)
@@ -49,6 +49,8 @@
loop (next, f (value, a0))
end
+ fun app f = fold (fn (l, ()) => f l) ()
+
fun get (self as LINK { prev=_, next=_, value }) = value
fun test (self as LINK { prev, next, value }) =
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-17 04:25:10 UTC (rev 5228)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-17 04:36:18 UTC (rev 5229)
@@ -22,10 +22,13 @@
(* The version of SQLite3 bound *)
val version: string
- (* Open and close databases -- all queries must be closed *)
+ (* Open and close databases *)
val openDB: string -> db
val closeDB: db -> unit
+ (* How many prepared queries are there *)
+ val preparedQueries: db -> int
+
(* You should ignore the type information here. It's confusing & useless.
* Use this structure as follows:
* local
@@ -37,8 +40,6 @@
* ...
* val () = SQL.app (fn (x & y) => ...) Q1 (1 & "arg2")
* val () = SQL.exec Q2 ()
- * val () = SQL.Query.close Q1
- * val () = SQL.Query.close Q2
*)
structure Query :
sig
@@ -60,9 +61,6 @@
('i, 'o) t, 'g) Fold.t
val $ : 'a * ('a -> 'b) -> 'b
- (* For every 'prepare' 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
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-17 04:25:10 UTC (rev 5228)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-17 04:36:18 UTC (rev 5229)
@@ -13,12 +13,9 @@
val version = Prim.version
- fun columns q = Prim.columns (Query.peek q)
- fun columnsMeta q = Prim.meta (Query.peek q)
-
fun getDB dbl =
- case Ring.get dbl of { db, query=_, available=_, used=_ } =>
- db
+ case Ring.get dbl of { db, query=_, available=_, used } =>
+ if !used = ~1 then raise Error "Database closed" else db
fun openDB file =
Ring.new { db = Prim.openDB file,
@@ -26,8 +23,32 @@
available = ref [],
used = ref 0 }
- val closeDB = Prim.closeDB o getDB
+ fun closeDB dbl =
+ let
+ val db = getDB dbl (* raises if closed *)
+ fun notInUse { db=_, query=_, available=_, used } = !used = 0
+
+ val exn = ref NONE
+ fun reraise NONE = ()
+ | reraise (SOME x) = raise x
+
+ fun forceClose q = Prim.finalize q handle x => exn := SOME x
+ fun close { db=_, query=_, available, used } = (
+ List.app forceClose (!available);
+ available := [];
+ used := ~1)
+ in
+ if Ring.fold (fn (l, a) => notInUse l andalso a) true dbl
+ then (Ring.app close dbl; reraise (!exn); Prim.closeDB db)
+ else raise Error "Database in use"
+ end
+ fun preparedQueries dbl =
+ Ring.fold (fn (_, x) => x + 1) ~1 dbl
+
+ fun columns q = Query.peek (q, Prim.columns)
+ fun columnsMeta q = Query.peek (q, Prim.meta)
+
datatype 'v stop = STOP | CONTINUE of 'v
fun iterStop q i =
@@ -36,12 +57,14 @@
val (pq, oF) = Query.alloc (q, i)
fun stop () = (
Query.release (q, pq);
- ok := false)
+ ok := false;
+ NONE)
in
- fn STOP => (stop (); NONE)
+ fn STOP =>
+ if not (!ok) then NONE else stop ()
| (CONTINUE ()) =>
if not (!ok) then NONE else
- if Prim.step pq then SOME (oF pq) else (stop (); NONE)
+ if Prim.step pq then SOME (oF pq) else stop ()
end
fun mapStop f q i =
@@ -95,14 +118,14 @@
let
val Q = prepare db qs oAS $
in
- table Q () before close Q
+ table Q ()
end
fun simpleExec (db, qs) =
let
val Q = prepare db qs $
in
- exec Q () before close Q
+ exec Q ()
end
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb 2007-02-17 04:25:10 UTC (rev 5228)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb 2007-02-17 04:36:18 UTC (rev 5229)
@@ -11,7 +11,7 @@
pointers.sml
prim.sml
end
-(* debug.sml *) (* wraps all the primitive methods to check execution *)
+ (* debug.sml *) (* wraps all the primitive methods to check execution *)
fold.sig
fold.sml
More information about the MLton-commit
mailing list