[MLton-commit] r5191

Wesley Terpstra wesley at mlton.org
Wed Feb 14 07:33:12 PST 2007


rename things in preparation of callback methods and query pools
----------------------------------------------------------------------

U   mltonlib/trunk/ca/terpstra/sqlite3/demo.sml
U   mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
U   mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
A   mltonlib/trunk/ca/terpstra/sqlite3/query.sml
U   mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
U   mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
U   mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
D   mltonlib/trunk/ca/terpstra/sqlite3/template.sml

----------------------------------------------------------------------

Modified: mltonlib/trunk/ca/terpstra/sqlite3/demo.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/demo.sml	2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/demo.sml	2007-02-14 15:33:12 UTC (rev 5191)
@@ -11,15 +11,15 @@
 val db = SQL.openDB dbname handle SQL.Error x => die x
 
 local
-  open SQL.Template
+  open SQL.Query
 in
-  val Q1 = query db "select x, y from peanuts\n\
-                    \where y="iI" or x="iS";" oS oI $
+  val Q1 = prepare db "select x, y from peanuts\n\
+                      \where y="iI" or x="iS";" oS oI $
            handle SQL.Error x => die x
 end
 
 fun dump (s & i) = print (s ^ " " ^ Int.toString i ^ "\n")
 val a  = SQL.app dump Q1 (arg & "hi") handle SQL.Error x => die x
 
-val () = SQL.close Q1
+val () = SQL.Query.close Q1
 val () = SQL.closeDB db

Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sig	2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sig	2007-02-14 15:33:12 UTC (rev 5191)
@@ -21,6 +21,8 @@
       val step:     query -> bool
       val clearbindings: query -> unit
       
+      val query_string: query -> string
+      
       datatype storage = INTEGER of Int64.int
                        | REAL of real
                        | STRING of string

Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml	2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml	2007-02-14 15:33:12 UTC (rev 5191)
@@ -50,6 +50,7 @@
       (* we don't support any of the hooks, or user completion stuff yet *)
       
       val Pdb_handle = _import "sqlite3_db_handle" : MLton.Pointer.t -> MLton.Pointer.t;
+      val Pquery_string = _import "sqlite3_query_string" : MLton.Pointer.t -> MLton.Pointer.t;
       
       (* expiry should just raise an exception... *)
       
@@ -138,6 +139,8 @@
           | r => (wrap (q, r); raise Error "unreachable")
       fun clearbindings q = wrap (q, Pclearbindings q)
       
+      fun query_string q = valOf (cstr (Pquery_string q))
+      
       datatype storage = INTEGER of Int64.int
                        | REAL of real
                        | STRING of string (* WideString.string? *)

Copied: mltonlib/trunk/ca/terpstra/sqlite3/query.sml (from rev 5176, mltonlib/trunk/ca/terpstra/sqlite3/template.sml)
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/template.sml	2007-02-12 19:09:13 UTC (rev 5176)
+++ mltonlib/trunk/ca/terpstra/sqlite3/query.sml	2007-02-14 15:33:12 UTC (rev 5191)
@@ -0,0 +1,80 @@
+structure Query =
+   struct
+      (* Cry ... *)
+      type 'a oF = Prim.query -> 'a
+      type ('b, 'c) oN = Prim.query * (unit -> 'b) -> 'c
+      type 'd iF = Prim.query * 'd -> unit
+      type ('e, 'f) iN = Prim.query * 'e -> int * 'f
+      type ('i, 'o, 'w, 'x, 'y, 'z) acc = string list * 'o oF * ('w, 'x) oN * int * 'i iF * ('y, 'z) iN
+      type ('v, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output = 
+           (('i, 'o, 'v, 'p,            'a, 'b) acc, 
+            ('i, 'p, 'q, ('p, 'q) pair, 'a, 'b) acc, 
+            'x, 'y, 'z) Fold.step0
+      type ('v, 'i, 'o, 'j, 'k, 'a, 'b, 'x, 'y, 'z) input = 
+           (string, ('i, 'o, 'a, 'b, 'j, 'v) acc, 
+                    ('j, 'o, 'a, 'b, ('j, 'k) pair, 'k) acc, 
+                    'x, 'y, 'z) Fold.step1
+      
+(*
+      type ('i, 'o) t = { Word8Vector.vector,
+                          pool: Prim.query list ref,
+                          used: int ref,
+                          iF:   Prim.query * 'i -> unit,
+                          oF:   Prim.query -> 'o }
+*)
+      type ('i, 'o) t = Prim.query * (Prim.query * 'i -> unit) * (Prim.query -> 'o)      
+      
+      fun oF0 _ = ()
+      fun oN0 (q, n) = n ()
+      val oI0 = 0
+      fun iF0 (q, ()) = ()
+      fun iN0 (q, x) = (1, x)
+      
+      fun prepare db qs = Fold.fold (([qs], oF0, oN0, oI0, iF0, iN0),
+                                     fn (ql, oF, _, oI, iF, _) => 
+                                     let val qs = concat (rev ql)
+                                         val q = Prim.prepare (db, qs)
+                                     in  if Prim.cols q < oI
+                                         then (Prim.finalize q;
+                                               raise Fail "insufficient output columns")
+                                         else (q, iF, oF)
+                                     end)
+      (* terminate an expression with this: *)
+      val $ = $
+      
+      fun close (q, _, _) = Prim.finalize q
+      
+      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)) => 
+                                  (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 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) => 
+                                  (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 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) => 
+                                   (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 oAS z = oMapA Prim.fetchS z
+      fun oAX z = oMapA Prim.fetchX z
+   end      

Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sig	2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sig	2007-02-14 15:33:12 UTC (rev 5191)
@@ -1,69 +1,30 @@
-(*
- *)
-
 signature SQL =
    sig
       type db
-      type ('i, 'o) query
       type column = { name: string }
       
-      exception Retry of string
-      exception Abort of string
-      exception Error of string
-      
-      (* The version of SQLite3 bound *)
-      val version: string
-      
-      (* Open and close databases -- all queries must be closed *)
-      val openDB: string -> db
-      val closeDB: db -> unit
-      
-      (* For every 'query' you must eventually run this: *)
-      val close: ('i, 'o) query -> unit
-      
-      (* Meta-data about the columns in the output *)
-      val columns: ('i, 'o) query -> column vector
-      
-      (* Transform a query into an iterator *)
-      val iter: ('i, 'o) query -> 'i -> unit -> 'o option
-      
-      (* Run a function on each output row from a query *)
-      val map: ('o -> 'v) -> ('i, 'o) query -> 'i -> 'v vector
-      val app: ('o -> unit) -> ('i, 'o) query -> 'i -> unit
-      
-      (* Run a function on each output row, and allow premature completion *)
-      datatype 'v stop = STOP | CONTINUE of 'v
-      val mapStop: ('o -> 'v stop) -> ('i, 'o) query -> 'i -> 'v vector
-      val appStop: ('o -> unit stop) -> ('i, 'o) query -> 'i -> unit
-      
-      (* Convenience functions that work with the identity *)
-      val table: ('i, 'o) query -> 'i -> 'o vector
-      val exec: ('i, unit) query -> 'i -> unit
-      
-      (* For simple queries you only run once, use: *)
-      val simple: db * string -> string vector vector
-      
+      (* For unconverted type values *)
       datatype storage = INTEGER of Int64.int
                        | REAL of real
                        | STRING of string
                        | BLOB of Word8Vector.vector
                        | NULL
       
-      (* You should ignore the type information here. It's confusing and useless.
+      (* You should ignore the type information here. It's confusing & useless.
        * Use this structure as follows:
        * local
-       *   open SQL.Template
+       *   open SQL.Query
        * in
-       *   val Q1 = query db "select (a, b) from table 1where x="iI" and y="iS";" oS oR $
-       *   val Q2 = query db "insert into table2 values (4, 6);" $
+       *   val Q1 = prepare db "select (a, b) from table 1where x="iI" and y="iS";" oS oR $
+       *   val Q2 = prepare db "insert into table2 values (4, 6);" $
        * end
        * ...
        * val () = SQL.app (fn (x & y) => ...) Q1 (1 & "arg2")
        * val () = SQL.exec Q2 ()
-       * val () = SQL.close Q1
-       * val () = SQL.close Q2
+       * val () = SQL.Query.close Q1
+       * val () = SQL.Query.close Q2
        *)
-      structure Template :
+      structure Query :
          sig
             type ('i, 'o, 'w, 'x, 'y, 'z) acc
             type ('v, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output = 
@@ -75,11 +36,15 @@
                         ('j, 'o, 'a, 'b, ('j, 'k) pair, 'k) acc, 
                         'x, 'y, 'z) Fold.step1
             
-            val query: db -> string -> ((unit, unit, 'a, 'a, 'b, 'b) acc,
-                                        ('i,   'o,   'c, 'd, 'e, 'f) acc, 
-                                        ('i, 'o) query, 'g) Fold.t
+            type ('i, 'o) t
+            val prepare: db -> string -> ((unit, unit, 'a, 'a, 'b, 'b) acc,
+                                          ('i,   'o,   'c, 'd, 'e, 'f) acc, 
+                                          ('i, 'o) t, 'g) Fold.t
             val $ : 'a * ('a -> 'b) -> 'b
             
+            (* For every 'query' you must eventually run this: *)
+            val close: ('i, 'o) t -> unit
+            
             (* Convert the next column to the desired type *)
             val oB: (Word8Vector.vector, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
             val oR: (real,               'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output
@@ -104,4 +69,39 @@
             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
+      
+      exception Retry of string
+      exception Abort of string
+      exception Error of string
+      
+      (* The version of SQLite3 bound *)
+      val version: string
+      
+      (* Open and close databases -- all queries must be closed *)
+      val openDB: string -> db
+      val closeDB: db -> unit
+      
+      (* Meta-data about the columns in the output *)
+      val columns: ('i, 'o) Query.t -> column vector
+      
+      (* Transform a query into an iterator *)
+      val iter: ('i, 'o) Query.t -> 'i -> unit -> 'o option
+      
+      (* Run a function on each output row from a query *)
+      val map: ('o -> 'v) -> ('i, 'o) Query.t -> 'i -> 'v vector
+      val app: ('o -> unit) -> ('i, 'o) Query.t -> 'i -> unit
+      
+      (* Run a function on each output row, allowing premature completion *)
+      datatype 'v stop = STOP | CONTINUE of 'v
+      val mapStop: ('o -> 'v stop) -> ('i, 'o) Query.t -> 'i -> 'v vector
+      val appStop: ('o -> unit stop) -> ('i, 'o) Query.t -> 'i -> unit
+      val iterStop: ('i, 'o) Query.t -> 'i -> unit stop -> 'o option
+      
+      (* Convenience functions that work with the identity *)
+      val table: ('i, 'o) Query.t -> 'i -> 'o vector
+      val exec: ('i, unit) Query.t -> 'i -> unit
+      
+      (* For simple queries you only run once, use: *)
+      val simpleTable: db * string -> string vector vector
+      val simpleExec: db * string -> unit
    end

Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml	2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml	2007-02-14 15:33:12 UTC (rev 5191)
@@ -1,6 +1,5 @@
 structure SQL :> SQL =
    struct
-      type ('i, 'o) query = Prim.query * (Prim.query * 'i -> unit) * (Prim.query -> 'o)
       type column = Prim.column
       type db = Prim.db
       datatype storage = datatype Prim.storage
@@ -9,17 +8,18 @@
       exception Abort = Prim.Abort
       exception Error = Prim.Error
       
-      structure Template = Template
+      structure Query = Query
       
       val version = Prim.version
       
-      fun close (q, _, _) = Prim.finalize q
       fun columns (q, _, _) = Prim.meta q
       
       val openDB  = Prim.openDB
       val closeDB = Prim.closeDB
       
-      fun iter (q, iF, oF) i =
+      datatype 'v stop = STOP | CONTINUE of 'v
+      
+      fun iterStop (q, iF, oF) i =
          let
             val () = iF (q, i)
             val ok = ref true
@@ -29,13 +29,12 @@
                Prim.clearbindings q;
                ok := false)
          in
-            fn () =>
-               if not (!ok) then NONE else
-               if Prim.step q then SOME (oF q) else (stop (); NONE)
+            fn STOP => (stop (); NONE)
+             | (CONTINUE ()) =>
+                  if not (!ok) then NONE else
+                  if Prim.step q then SOME (oF q) else (stop (); NONE)
          end
       
-      datatype 'v stop = STOP | CONTINUE of 'v
-      
       fun mapStop f (q, iF, oF) i =
          let
             val () = iF (q, i)
@@ -75,18 +74,31 @@
       
       fun map f = mapStop (CONTINUE o f)
       fun app f = appStop (CONTINUE o f)
+      fun iter q i =
+         let
+            val step = iterStop q i
+         in
+            fn () => step (CONTINUE ())
+         end
       
       fun table q = map (fn x  => x)  q
       fun exec  q = app (fn () => ()) q
       
       local
-         open Template
+         open Query
       in
-         fun simple (db, qs) =
+         fun simpleTable (db, qs) =
             let
-               val Q = query db qs oAS $
+               val Q = prepare db qs oAS $
             in
                table Q () before close Q
             end
+         
+         fun simpleExec (db, qs) =
+            let
+               val Q = prepare db qs $
+            in
+               exec Q () before close Q
+            end
       end
    end

Modified: mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb	2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb	2007-02-14 15:33:12 UTC (rev 5191)
@@ -16,7 +16,7 @@
    pair.sml
    sql.sig
    local
-     template.sml
+     query.sml
    in
      sql.sml
    end

Deleted: mltonlib/trunk/ca/terpstra/sqlite3/template.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/template.sml	2007-02-14 12:35:25 UTC (rev 5190)
+++ mltonlib/trunk/ca/terpstra/sqlite3/template.sml	2007-02-14 15:33:12 UTC (rev 5191)
@@ -1,69 +0,0 @@
-structure Template =
-   struct
-      (* Cry ... *)
-      type 'a oF = Prim.query -> 'a
-      type ('b, 'c) oN = Prim.query * (unit -> 'b) -> 'c
-      type 'd iF = Prim.query * 'd -> unit
-      type ('e, 'f) iN = Prim.query * 'e -> int * 'f
-      type ('i, 'o, 'w, 'x, 'y, 'z) acc = string list * 'o oF * ('w, 'x) oN * int * 'i iF * ('y, 'z) iN
-      type ('v, 'i, 'o, 'p, 'q, 'a, 'b, 'x, 'y, 'z) output = 
-           (('i, 'o, 'v, 'p,            'a, 'b) acc, 
-            ('i, 'p, 'q, ('p, 'q) pair, 'a, 'b) acc, 
-            'x, 'y, 'z) Fold.step0
-      type ('v, 'i, 'o, 'j, 'k, 'a, 'b, 'x, 'y, 'z) input = 
-           (string, ('i, 'o, 'a, 'b, 'j, 'v) acc, 
-                    ('j, 'o, 'a, 'b, ('j, 'k) pair, 'k) acc, 
-                    'x, 'y, 'z) Fold.step1
-      
-      fun oF0 _ = ()
-      fun oN0 (q, n) = n ()
-      val oI0 = 0
-      fun iF0 (q, ()) = ()
-      fun iN0 (q, x) = (1, x)
-      
-      fun query db qs = Fold.fold (([qs], oF0, oN0, oI0, iF0, iN0),
-                                   fn (ql, oF, _, oI, iF, _) => 
-                                   let val qs = concat (rev ql)
-                                       val q = Prim.prepare (db, qs)
-                                   in  if Prim.cols q < oI
-                                       then (Prim.finalize q;
-                                             raise Fail "insufficient output columns")
-                                       else (q, iF, oF)
-                                   end)
-      (* terminate an expression with this: *)
-      val $ = $
-      
-      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)) => 
-                                  (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 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) => 
-                                  (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 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) => 
-                                   (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 oAS z = oMapA Prim.fetchS z
-      fun oAX z = oMapA Prim.fetchX z
-   end      




More information about the MLton-commit mailing list