[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