[MLton-commit] r5232
Wesley Terpstra
wesley at mlton.org
Sat Feb 17 07:45:19 PST 2007
recover memory from registered functions on close
----------------------------------------------------------------------
U mltonlib/trunk/ca/terpstra/sqlite3/buffer.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/sql.sig
U mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/ca/terpstra/sqlite3/buffer.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/buffer.sml 2007-02-17 14:43:00 UTC (rev 5231)
+++ mltonlib/trunk/ca/terpstra/sqlite3/buffer.sml 2007-02-17 15:45:18 UTC (rev 5232)
@@ -42,7 +42,7 @@
fun free ({ buf, free }, i) = (
(*
case Array.sub (!buf, i) of
- FREE _ => raise "Free of unused space in Buffer.free"
+ FREE _ => raise Fail "Free of unused space in Buffer.free"
| FULL _ =>
*)
Array.update (!buf, i, FREE (IntX.fromInt (!free)));
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-17 14:43:00 UTC (rev 5231)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-17 15:45:18 UTC (rev 5232)
@@ -79,9 +79,10 @@
type aggregate = { step: context * value vector -> unit,
final: context -> unit }
- val createFunction: db * string * (context * value vector -> unit) * int -> unit
- val createCollation: db * string * (string * string -> order) -> unit
- val createAggregate: db * string * (unit -> aggregate) * int -> unit
+ type hook
+ val createFunction: db * string * (context * value vector -> unit) * int -> hook
+ val createCollation: db * string * (string * string -> order) -> hook
+ val createAggregate: db * string * (unit -> aggregate) * int -> hook
val lastInsertRowid: db -> Int64.int
val changes: db -> int
@@ -114,4 +115,7 @@
| DROP_VTABLE of { table: string, module: string, db: string }
| FUNCTION of { function: string }
val setAuthorizer: db * (request -> access) option -> unit
+
+ (* Only do this after closing the database or unbinding the fn *)
+ val unhook: hook -> unit
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-17 14:43:00 UTC (rev 5231)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-17 15:45:18 UTC (rev 5232)
@@ -259,8 +259,7 @@
type callback = Context.t * Value.t vector -> unit
- (* !!! somehow record the ids to free in the db handle? *)
-
+ datatype hook = UFN of int | COLL of int | AGGR of int
(************************************************* Scalar functions *)
val fnt = Buffer.empty ()
fun fnCallback (context, numargs, args) =
@@ -281,9 +280,15 @@
val fnCallbackPtr = _address "mlton_sqlite3_ufnhook" : FnPtr.t;
fun createFunction (db, name, f, n) =
- code (db, Pcreate_function (db, CStr.fromString name, n, 1,
- Word.fromInt (Buffer.push (fnt, f)),
- fnCallbackPtr, FnPtr.null, FnPtr.null))
+ let
+ val id = Buffer.push (fnt, f)
+ val r = Pcreate_function (
+ db, CStr.fromString name, n, 1, Word.fromInt id,
+ fnCallbackPtr, FnPtr.null, FnPtr.null)
+ in
+ code (db, r);
+ UFN id
+ end
(************************************************* Aggregate functions *)
type aggregate = {
@@ -343,10 +348,16 @@
val agFinalCallbackPtr = _address "mlton_sqlite3_uagfinal" : FnPtr.t;
fun createAggregate (db, name, gen, n) =
- code (db, Pcreate_function (db, CStr.fromString name, n, 1,
- Word.fromInt (Buffer.push (aggen, gen)),
- FnPtr.null, agStepCallbackPtr, agFinalCallbackPtr))
-
+ let
+ val id = Buffer.push (aggen, gen)
+ val r = Pcreate_function (
+ db, CStr.fromString name, n, 1, Word.fromInt id,
+ FnPtr.null, agStepCallbackPtr, agFinalCallbackPtr)
+ in
+ code (db, r);
+ AGGR id
+ end
+
(************************************************* Collation functions *)
val colt = Buffer.empty ()
fun colCallback (uarg, s1l, s1p, s2l, s2p) =
@@ -368,10 +379,18 @@
colCallback
val colCallbackPtr = _address "mlton_sqlite3_colhook" : FnPtr.t;
fun createCollation (db, name, f) =
- code (db, Pcreate_collation (db, CStr.fromString name, 1,
- Word.fromInt (Buffer.push (colt, f)),
- colCallbackPtr))
+ let
+ val id = Buffer.push (colt, f)
+ val r = Pcreate_collation (
+ db, CStr.fromString name, 1, Word.fromInt id,
+ colCallbackPtr)
+ in
+ code (db, r);
+ COLL id
+ end
+ (************************************************* End of user functions *)
+
val lastInsertRowid = PlastInsertRowid
val changes = Pchanges
val totalChanges = PtotalChanges
@@ -443,6 +462,10 @@
fun setAuthorizer _ = ()
+ fun unhook (UFN x) = Buffer.free (fnt, x)
+ | unhook (COLL x) = Buffer.free (colt, x)
+ | unhook (AGGR x) = Buffer.free (aggen, x)
+
type db = DB.t
type query = Query.t
type value = Value.t
Modified: mltonlib/trunk/ca/terpstra/sqlite3/query.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/query.sml 2007-02-17 14:43:00 UTC (rev 5231)
+++ mltonlib/trunk/ca/terpstra/sqlite3/query.sml 2007-02-17 15:45:18 UTC (rev 5232)
@@ -86,8 +86,8 @@
Ring.remove l
)
in
- fun prepare dbl qt =
- case Ring.get dbl of { db, query=_, available=_, used=_ } =>
+ fun prepare { ring, hooks } qt =
+ case Ring.get ring of { db, query=_, available=_, used=_ } =>
Fold.fold (([qt], oF0, oN0, oI0, iF0, iN0),
fn (ql, oF, _, oI, iF, _) =>
let
@@ -104,7 +104,7 @@
Ring.add ({ db = db,
query = qs,
available = ref [q],
- used = ref 0 }, dbl))
+ used = ref 0 }, ring))
val out = { pool = pool, iF = iF, oF = oF }
in
MLton.Finalizable.addFinalizer (pool, close);
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-17 14:43:00 UTC (rev 5231)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-17 15:45:18 UTC (rev 5232)
@@ -189,7 +189,10 @@
(* get/set auxdata? could be useful *)
end
- (* SQL.Error exceptions in callbacks are propogated ok. Others not. *)
+ (* SQL.Error exceptions in callbacks are propogated ok. Others not.
+ * If you want to change the method later, do it inside your function.
+ * Once registered, a function stays bound until closeDB.
+ *)
val registerFunction: db * string * Function.scalar -> unit
val registerAggregate: db * string * Function.aggregate -> unit
val registerCollation: db * string * (string * string -> order) -> unit
@@ -204,6 +207,7 @@
(* Number of prepared queries not yet garbage collected *)
val preparedQueries: db -> int
+ val registeredFunctions: db -> int
datatype access = ALLOW | DENY | IGNORE
datatype request =
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-17 14:43:00 UTC (rev 5231)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-17 15:45:18 UTC (rev 5232)
@@ -1,7 +1,7 @@
structure SQL :> SQL =
struct
type column = Prim.column
- type db = Query.pool Ring.t
+ type db = { ring: Query.pool Ring.t, hooks: Prim.hook list ref }
datatype storage = datatype Prim.storage
exception Retry = Prim.Retry
@@ -13,19 +13,20 @@
val version = Prim.version
- fun getDB dbl =
- case Ring.get dbl of { db, query=_, available=_, used } =>
+ fun getDB { ring, hooks=_ } =
+ case Ring.get ring of { db, query=_, available=_, used } =>
if !used = ~1 then raise Error "Database closed" else db
- fun openDB file =
- Ring.new { db = Prim.openDB file,
- query = "database",
- available = ref [],
- used = ref 0 }
+ fun openDB file = {
+ ring = Ring.new { db = Prim.openDB file,
+ query = "database",
+ available = ref [],
+ used = ref 0 },
+ hooks = ref [] }
- fun closeDB dbl =
+ fun closeDB (dbh as { ring, hooks }) =
let
- val db = getDB dbl (* raises if closed *)
+ val db = getDB dbh (* raises if closed *)
fun notInUse { db=_, query=_, available=_, used } = !used = 0
val exn = ref NONE
@@ -38,8 +39,12 @@
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)
+ 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 := [])
else raise Error "Database in use"
end
@@ -126,14 +131,14 @@
end
end
- fun registerFunction (db, s, (f, i)) =
- Prim.createFunction (getDB db, s, f, i)
+ fun registerFunction (db as { ring=_, hooks }, s, (f, i)) =
+ hooks := Prim.createFunction (getDB db, s, f, i) :: !hooks
- fun registerAggregate (db, s, (a, i)) =
- Prim.createAggregate (getDB db, s, a, i)
+ fun registerAggregate (db as { ring=_, hooks }, s, (a, i)) =
+ hooks := Prim.createAggregate (getDB db, s, a, i) :: !hooks
- fun registerCollation (db, s, c) =
- Prim.createCollation (getDB db, s, c)
+ fun registerCollation (db as { ring=_, hooks }, s, c) =
+ hooks := Prim.createCollation (getDB db, s, c) :: !hooks
structure SQLite =
struct
@@ -142,8 +147,10 @@
val totalChanges = Prim.totalChanges o getDB
val transactionActive = not o Prim.getAutocommit o getDB
- fun preparedQueries dbl =
- Ring.fold (fn (_, x) => x + 1) ~1 dbl
+ fun preparedQueries { ring, hooks=_ } =
+ Ring.fold (fn (_, x) => x + 1) ~1 ring
+ fun registeredFunctions { ring=_, hooks } =
+ List.length (!hooks)
datatype access = datatype Prim.access
datatype request = datatype Prim.request
More information about the MLton-commit
mailing list