[MLton-commit] r5272
Wesley Terpstra
wesley at mlton.org
Tue Feb 20 05:29:47 PST 2007
move the atomic action outwards to include closing the query
----------------------------------------------------------------------
U mltonlib/trunk/ca/terpstra/sqlite3-sml/query.sml
U mltonlib/trunk/ca/terpstra/sqlite3-sml/ring.sml
U mltonlib/trunk/ca/terpstra/sqlite3-sml/sql.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/ca/terpstra/sqlite3-sml/query.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3-sml/query.sml 2007-02-20 09:11:59 UTC (rev 5271)
+++ mltonlib/trunk/ca/terpstra/sqlite3-sml/query.sml 2007-02-20 13:29:46 UTC (rev 5272)
@@ -103,10 +103,10 @@
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);
+ ( Ring.remove l;
+ List.app forceClose (!available);
available := [];
- used := ~1;
- Ring.remove l
+ used := ~1
)
in
fun prepare { ring, hooks=_, auth=_ } qt =
@@ -128,15 +128,15 @@
\ for specified prototype")
else
let
- val pool = MLton.Finalizable.new (
- Ring.add ({ db = db,
- query = qs,
- available = ref [q],
- used = ref 0 }, ring))
- val out = { pool = pool, iF = iF, oF = oF }
+ val atom = MLton.Thread.atomically
+ val new = MLton.Finalizable.new
+ val i = { db = db, query = qs,
+ available = ref [q], used = ref 0 }
+ fun closeA pool = atom (fn () => close pool)
+ val pool = atom (fn () => new (Ring.add (i, ring)))
in
- MLton.Finalizable.addFinalizer (pool, close);
- out
+ MLton.Finalizable.addFinalizer (pool, closeA);
+ { pool = pool, iF = iF, oF = oF }
end
end)
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3-sml/ring.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3-sml/ring.sml 2007-02-20 09:11:59 UTC (rev 5271)
+++ mltonlib/trunk/ca/terpstra/sqlite3-sml/ring.sml 2007-02-20 13:29:46 UTC (rev 5272)
@@ -38,7 +38,6 @@
in
self
end
- val add = fn x => MLton.Thread.atomically (fn () => add x)
fun remove (self as LINK { prev, next, value=_ }) =
let
@@ -51,7 +50,6 @@
in
()
end
- val remove = fn x => MLton.Thread.atomically (fn () => remove x)
fun fold f a0 (LINK { prev=_, next, value }) =
let
@@ -62,8 +60,6 @@
in
loop (next, f (value, a0))
end
- val fold = fn x => fn y => fn z =>
- MLton.Thread.atomically (fn () => fold x y z)
fun app f = fold (fn (l, ()) => f l) ()
Modified: mltonlib/trunk/ca/terpstra/sqlite3-sml/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3-sml/sql.sml 2007-02-20 09:11:59 UTC (rev 5271)
+++ mltonlib/trunk/ca/terpstra/sqlite3-sml/sql.sml 2007-02-20 13:29:46 UTC (rev 5272)
@@ -34,7 +34,7 @@
fun openDB file = {
ring = Ring.new { db = Prim.openDB file,
- query = "database",
+ query = "database",
available = ref [],
used = ref 0 },
hooks = ref [],
@@ -54,16 +54,19 @@
List.app forceClose (!available);
available := [];
used := ~1)
+
+ fun main () =
+ if Ring.fold (fn (l, a) => notInUse l andalso a) true ring
+ then (Ring.app close ring;
+ reraise (!exn);
+ Prim.closeDB db;
+ List.app Prim.unhook (!hooks);
+ hooks := [];
+ Option.app Prim.unhook (!auth);
+ auth := NONE)
+ else raise Error "Database in use"
in
- if Ring.fold (fn (l, a) => notInUse l andalso a) true ring
- then (Ring.app close ring;
- reraise (!exn);
- Prim.closeDB db;
- List.app Prim.unhook (!hooks);
- hooks := [];
- Option.app Prim.unhook (!auth);
- auth := NONE)
- else raise Error "Database in use"
+ MLton.Thread.atomically (fn () => main ())
end
fun columns q = Query.peek (q, Prim.columns)
@@ -166,7 +169,8 @@
val transactionActive = not o Prim.getAutocommit o getDB
fun preparedQueries { ring, hooks=_, auth=_ } =
- Ring.fold (fn (_, x) => x + 1) ~1 ring
+ MLton.Thread.atomically
+ (fn () => Ring.fold (fn (_, x) => x + 1) ~1 ring)
fun registeredFunctions { ring=_, hooks, auth=_ } =
List.length (!hooks)
More information about the MLton-commit
mailing list