[MLton-commit] r5238
Wesley Terpstra
wesley at mlton.org
Sat Feb 17 13:00:19 PST 2007
get compilation with warnUnused happy. added null fetch methods for completeness
----------------------------------------------------------------------
U mltonlib/trunk/ca/terpstra/sqlite3/function.sml
U mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
U mltonlib/trunk/ca/terpstra/sqlite3/query.sml
U mltonlib/trunk/ca/terpstra/sqlite3/ring.sml
U mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/ca/terpstra/sqlite3/function.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/function.sml 2007-02-17 17:17:49 UTC (rev 5237)
+++ mltonlib/trunk/ca/terpstra/sqlite3/function.sml 2007-02-17 21:00:18 UTC (rev 5238)
@@ -34,9 +34,9 @@
fun fnR z = fnMap Prim.resultR z
fun fnI z = fnMap Prim.resultI z
fun fnZ z = fnMap Prim.resultZ z
+ fun fnN z = fnMap Prim.resultN z
fun fnS z = fnMap Prim.resultS z
fun fnX z = fnMap Prim.resultX z
- fun fnN z = fnMap Prim.resultN z
fun aggrMap r = Fold.fold ((iI0, iF0, iN0),
fn (iI, iF, _) =>
@@ -54,31 +54,33 @@
fun aggrR z = aggrMap Prim.resultR z
fun aggrI z = aggrMap Prim.resultI z
fun aggrZ z = aggrMap Prim.resultZ z
+ fun aggrN z = aggrMap Prim.resultN z
fun aggrS z = aggrMap Prim.resultS z
fun aggrX z = aggrMap Prim.resultX z
- fun aggrN z = aggrMap Prim.resultN z
(* terminate an expression with this: *)
val $ = $
fun iFx f (iN, iI) v = iN (v, fn () => f (Vector.sub (v, iI)))
fun iNx f (iN, iI) (v, n) = iN (v, fn () => f (Vector.sub (v, iI))) & n ()
- fun iMap f = Fold.step0 (fn (iI, iF, iN) =>
+ fun iMap f = Fold.step0 (fn (iI, _, iN) =>
(iI+1, iFx f (iN, iI), iNx f (iN, iI)))
fun iB z = iMap Prim.valueB z
fun iR z = iMap Prim.valueR z
fun iI z = iMap Prim.valueI z
fun iZ z = iMap Prim.valueZ z
+ fun iN z = iMap Prim.valueN z
fun iS z = iMap Prim.valueS z
fun iX z = iMap Prim.valueX z
fun iAFx f v = Vector.map f v
- fun iANx iF (v, n) = case iF v of () => () (* plug the type *)
+ fun iANx iF (v, _) = case iF v of () => () (* plug the type *)
fun iAMap f = Fold.step0 (fn (_, iF, _) => (~1, iAFx f, iANx iF))
fun iAB z = iAMap Prim.valueB z
fun iAR z = iAMap Prim.valueR z
fun iAI z = iAMap Prim.valueI z
fun iAZ z = iAMap Prim.valueZ z
+ fun iAN z = iAMap Prim.valueN z
fun iAS z = iAMap Prim.valueS z
fun iAX z = iAMap Prim.valueX z
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-17 17:17:49 UTC (rev 5237)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-17 21:00:18 UTC (rev 5238)
@@ -14,8 +14,8 @@
val PopenDB = _import "sqlite3_open" : CStr.t * DB.t ref -> int;
val PcloseDB= _import "sqlite3_close" : DB.t -> int;
- val Pfree = _import "sqlite3_free" : CStr.t -> unit;
val Perrmsg = _import "sqlite3_errmsg" : DB.t -> CStr.out;
+(* val Pfree = _import "sqlite3_free" : CStr.t -> unit; *)
(* val Perrcode= _import "sqlite3_errcode": DB.t -> int; *)
val Pfinalize = _import "sqlite3_finalize" : Query.t -> int;
@@ -99,7 +99,7 @@
val version = CStr.toString (Plibversion ())
fun why db = valOf (CStr.toStringOpt (Perrmsg db))
- fun code (db, 0) = () (* #define SQLITE_OK 0 /* Successful result */ *)
+ fun code (_, 0) = () (* #define SQLITE_OK 0 /* Successful result */ *)
| code (db, 1) = raise Error (why db) (* #define SQLITE_ERROR 1 /* SQL error or missing database */ *)
| code (db, 2) = raise Error (why db) (* #define SQLITE_INTERNAL 2 /* An internal logic error in SQLite */ *)
| code (db, 3) = raise Error (why db) (* #define SQLITE_PERM 3 /* Access permission denied */ *)
@@ -123,7 +123,7 @@
| code (db, 21) = raise Error (why db) (* #define SQLITE_MISUSE 21 /* Library used incorrectly */ *)
| code (db, 22) = raise Error (why db) (* #define SQLITE_NOLFS 22 /* Uses OS features not supported on host */ *)
| code (db, 23) = raise Abort (why db) (* #define SQLITE_AUTH 23 /* Authorization denied */ *)
- | code (db, _) = raise Error "SQLite returned an unknown error code"
+ | code _ = raise Error "SQLite returned an unknown error code"
fun openDB filename =
let
@@ -191,7 +191,7 @@
fun fetchR (q, i) = Pcolumn_double (q, i)
fun fetchI (q, i) = Pcolumn_int (q, i)
fun fetchZ (q, i) = Pcolumn_int64 (q, i)
- fun fetchN (q, i) = ()
+ fun fetchN (_, _) = ()
fun fetchS (q, i) = CStr.toStringLen (Pcolumn_text (q, i),
Pcolumn_bytes (q, i))
@@ -232,7 +232,7 @@
fun valueR v = Pvalue_double v
fun valueI v = Pvalue_int v
fun valueZ v = Pvalue_int64 v
- fun valueN v = ()
+ fun valueN _ = ()
fun valueS v = CStr.toStringLen (Pvalue_text v, Pvalue_bytes v)
fun valueX v =
@@ -257,11 +257,9 @@
| resultX (c, BLOB b) = resultB (c, b)
| resultX (c, NULL) = resultN (c, ())
- type callback = Context.t * Value.t vector -> unit
-
datatype hook = UFN of int | COLL of int | AGGR of int | AUTH of int
(************************************************* Scalar functions *)
- val fnt = Buffer.empty ()
+ val fnt : (Context.t * Value.t vector -> unit) Buffer.t = Buffer.empty ()
fun fnCallback (context, numargs, args) =
let
val f = Buffer.sub (fnt, Word.toInt (Puser_data context))
@@ -294,8 +292,8 @@
type aggregate = {
step: Context.t * Value.t vector -> unit,
final: Context.t -> unit }
- val aggen = Buffer.empty ()
- val agtbl = Buffer.empty ()
+ val aggen : (unit -> aggregate) Buffer.t = Buffer.empty ()
+ val agtbl : aggregate Buffer.t = Buffer.empty ()
fun fetchAggr context =
let
val magic = 0wxa72b (* new records are zero, we mark them magic *)
@@ -359,7 +357,7 @@
end
(************************************************* Collation functions *)
- val colt = Buffer.empty ()
+ val colt : (string * string -> order) Buffer.t = Buffer.empty ()
fun colCallback (uarg, s1l, s1p, s2l, s2p) =
let
val col = Buffer.sub (colt, Word.toInt uarg)
@@ -454,13 +452,13 @@
| switchRequest (30, a, b, c) = DROP_VTABLE { table = valOf a, module = valOf b, db = valOf c }
| switchRequest (31, _, b, _) = FUNCTION { function = valOf b }
| switchRequest (_, _, _, _) = raise Error "SQLite requested impossible authorization code"
- fun parseRequest (code, a, b, c, d) =
+ fun parseRequest (code, a, b, c, d) = (* !!! expose trigged? => d !!! *)
switchRequest (code, CStr.toStringOpt a,
CStr.toStringOpt b,
CStr.toStringOpt c)
handle Option => raise Error "SQLite did not provided expected authorization paramater"
- val autht = Buffer.empty ()
+ val autht : (request -> access) Buffer.t = Buffer.empty ()
fun authCallback (uarg, code, a, b, c, d) =
let
val auth = Buffer.sub (autht, Word.toInt uarg)
Modified: mltonlib/trunk/ca/terpstra/sqlite3/query.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/query.sml 2007-02-17 17:17:49 UTC (rev 5237)
+++ mltonlib/trunk/ca/terpstra/sqlite3/query.sml 2007-02-17 21:00:18 UTC (rev 5238)
@@ -1,3 +1,4 @@
+
structure Query =
struct
(* Cry ... *)
@@ -38,7 +39,7 @@
accessPool (pool, fn { db, query, available, used } =>
if !used = ~1 then raise Prim.Error "Database closed" else
case !available of
- x :: r => f x
+ x :: _ => f x
| [] =>
let
val pq = Prim.prepare (db, query)
@@ -70,10 +71,10 @@
available := pq :: !available))
fun oF0 _ = ()
- fun oN0 (q, n) = n ()
+ fun oN0 (_, n) = n ()
val oI0 = 0
- fun iF0 (q, ()) = ()
- fun iN0 (q, x) = (1, x)
+ fun iF0 (_, ()) = ()
+ fun iN0 (_, x) = (1, x)
local
fun forceClose q = Prim.finalize q handle _ => ()
@@ -96,7 +97,7 @@
in
if Prim.cols q < oI
then (Prim.finalize q;
- raise Prim.Error "insufficient output columns\
+ raise Prim.Error "Insufficient output columns\
\ to satisfy prototype")
else
let
@@ -118,35 +119,38 @@
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)) =>
+ fun iMap f = Fold.step1 (fn (qs, (ql, oF, oN, oI, _, 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 iN z = iMap Prim.bindN 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) =>
+ fun oMap f = Fold.step0 (fn (ql, _, 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 oN z = oMap Prim.fetchN 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) =>
+ fun oMapA f = Fold.step0 (fn (ql, _, 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 oAN z = oMapA Prim.fetchN z
fun oAS z = oMapA Prim.fetchS z
fun oAX z = oMapA Prim.fetchX z
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/ring.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/ring.sml 2007-02-17 17:17:49 UTC (rev 5237)
+++ mltonlib/trunk/ca/terpstra/sqlite3/ring.sml 2007-02-17 21:00:18 UTC (rev 5238)
@@ -40,7 +40,7 @@
end
val remove = fn x => MLton.Thread.atomically (fn () => remove x)
- fun fold f a0 (self as LINK { prev=_, next, value }) =
+ fun fold f a0 (LINK { prev=_, next, value }) =
let
fun loop (l, a) =
case valOf (!l) of LINK { prev=_, next=nl, value=x } =>
@@ -54,8 +54,9 @@
fun app f = fold (fn (l, ()) => f l) ()
- fun get (self as LINK { prev=_, next=_, value }) = value
+ fun get (LINK { prev=_, next=_, value }) = value
+(*
fun test (self as LINK { prev, next, value }) =
let
val LINK { prev=_, next=pn, value=_ } = valOf (!prev)
@@ -63,6 +64,7 @@
in
valOf (!pn) = self andalso valOf (!sp) = self andalso pn <> sp
end
+*)
end
(*
fun check l = List.foldl (fn (l, a) => Ring.test l andalso a) true l
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-17 17:17:49 UTC (rev 5237)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-17 21:00:18 UTC (rev 5238)
@@ -63,6 +63,7 @@
val oR: (real, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
val oI: (int, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
val oZ: (Int64.int, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oN: (unit, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
val oS: (string, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
val oX: (storage, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
@@ -71,6 +72,7 @@
val oAR: (real vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
val oAI: (int vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
val oAZ: (Int64.int vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
+ val oAN: (unit vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
val oAS: (string vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
val oAX: (storage vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
@@ -79,6 +81,7 @@
val iR: (real, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) input
val iI: (int, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) input
val iZ: (Int64.int, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) input
+ val iN: (unit, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) input
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
@@ -155,18 +158,18 @@
val fnR: (real, 'a, 'b, 'c, 'd, 'e) fnX
val fnI: (int, 'a, 'b, 'c, 'd, 'e) fnX
val fnZ: (Int64.int, 'a, 'b, 'c, 'd, 'e) fnX
+ val fnN: (unit, 'a, 'b, 'c, 'd, 'e) fnX
val fnS: (string, 'a, 'b, 'c, 'd, 'e) fnX
val fnX: (storage, 'a, 'b, 'c, 'd, 'e) fnX
- val fnN: (unit, 'a, 'b, 'c, 'd, 'e) fnX
(* Return types of the aggregate *)
val aggrB: (Word8Vector.vector, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
val aggrR: (real, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
val aggrI: (int, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
val aggrZ: (Int64.int, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
+ val aggrN: (unit, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
val aggrS: (string, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
val aggrX: (storage, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
- val aggrN: (unit, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
val $ : 'a * ('a -> 'b) -> 'b
@@ -175,6 +178,7 @@
val iR: (real, 'a, 'b, 'c, 'd, 'e, 'f) input
val iI: (int, 'a, 'b, 'c, 'd, 'e, 'f) input
val iZ: (Int64.int, 'a, 'b, 'c, 'd, 'e, 'f) input
+ val iN: (unit, 'a, 'b, 'c, 'd, 'e, 'f) input
val iS: (string, 'a, 'b, 'c, 'd, 'e, 'f) input
val iX: (storage, 'a, 'b, 'c, 'd, 'e, 'f) input
@@ -183,6 +187,7 @@
val iAR: (real, 'a, 'b, 'c) inputA
val iAI: (int, 'a, 'b, 'c) inputA
val iAZ: (Int64.int, 'a, 'b, 'c) inputA
+ val iAN: (unit, 'a, 'b, 'c) inputA
val iAS: (string, 'a, 'b, 'c) inputA
val iAX: (storage, 'a, 'b, 'c) inputA
More information about the MLton-commit
mailing list