[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