[MLton-commit] r5142

[Wesley Terpstra]

support reading all values with a single parameter, expose open/close, add convenience tupling
----------------------------------------------------------------------

U   mltonlib/trunk/ca/terpstra/sqlite3/sql.sml

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

Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml	2007-02-06 00:55:41 UTC (rev 5141)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml	2007-02-06 02:24:53 UTC (rev 5142)
@@ -1,6 +1,16 @@
 structure SQL =
    struct
-      fun iA (oF, b, (db, q), _) () =
+      type db = Prim.db
+      
+      exception Retry = Prim.Retry
+      exception Abort = Prim.Abort
+      exception Fail  = Prim.Fail
+      
+      val openDB  = Prim.openDB
+      val closeDB = Prim.closeDB
+      
+      fun outputEnds (_, _, f) = f ()
+      fun inputEnds ((oF, db, q), _, b) () =
          let
             val q = Prim.prepare (db, q)
             val () = b q
@@ -8,40 +18,64 @@
             fun exec NONE = (Prim.finalize q; NONE)
               | exec (SOME f) =
                    if Prim.step q 
-                   then SOME (oF (q, f, 0)) 
+                   then SOME (oF (q, 0, f)) 
                    else (Prim.finalize q; NONE)
          in
             exec
          end
       
-      fun oA (_, r, _) = r
-      
       fun execute db q =
-         Foldr.foldr (([], oA, iA), 
-                      fn (ql, oF, iF) => iF (oF, fn _ => (), (db, concat (q::ql)), 1))
+         Foldr.foldr (([], outputEnds, inputEnds), 
+                      fn (ql, oF, iF) => iF ((oF, db, concat (q::ql)), 1, fn _ => ()))
       
-      fun oFetch m s (q, f, i) = s (q, f (m (q, i)), i+1) 
-      fun oMap f = Foldr.step1 (fn (q, (ql, oF, iF)) => (q :: ql, f oF, iF))
-      fun oB z = oMap (oFetch Prim.fetchB) z
-      fun oR z = oMap (oFetch Prim.fetchR) z
-      fun oI z = oMap (oFetch Prim.fetchI) z
-      fun oZ z = oMap (oFetch Prim.fetchZ) z
-      fun oS z = oMap (oFetch Prim.fetchS) z
-      fun oX z = oMap (oFetch Prim.fetchX) z
+      (* typecast a single column and set it up as an argument *)
+      fun oFetch m s (q, i, f) = s (q, i+1, f (m (q, i)))
+      fun oMap f = Foldr.step1 (fn (q, (ql, oF, iF)) => (q :: ql, oFetch f oF, iF))
+      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 iBind m s (oF, b, d, i) x = s (oF, fn q => (b q; m (q, i, x)), d, i+1)
-      fun iMap f = Foldr.step1 (fn (q, (ql, oF, iF)) => ("?" :: q :: ql, oF, f iF))
-      fun iB z = iMap (iBind Prim.bindB) z
-      fun iR z = iMap (iBind Prim.bindR) z
-      fun iI z = iMap (iBind Prim.bindI) z
-      fun iZ z = iMap (iBind Prim.bindZ) z
-      fun iS z = iMap (iBind Prim.bindS) z
-      fun iX z = iMap (iBind Prim.bindX) z
+      (* typecast all columns to a vector and set it up as an argument *)
+      fun fetchA (q, m) = Vector.tabulate (Prim.cols q, fn i => m (q, i))
+      fun oFetchA m s (q, i, f) = s (q, i, f (fetchA (q, m)))
+      fun oMapA f = Foldr.step0 (fn (ql, oF, iF) => (ql, oFetchA f oF, iF))
+      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
+      
+      fun iBind m s (z, i, b) x = s (z, i+1, fn q => (b q; m (q, i, x)))
+      fun iMap f = Foldr.step1 (fn (q, (ql, oF, iF)) => ("?" :: q :: ql, oF, iBind f iF))
+      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 i0 f () = f ()
+      fun i1 f (a) = f a ()
+      fun i2 f (a, b) = f a b ()
+      fun i3 f (a, b, c) = f a b c ()
+      fun i4 f (a, b, c, d) = f a b c d ()
+      fun i5 f (a, b, c, d, e) = f a b c d e ()
+      
+      fun ox g m () = g (SOME m)
+      fun o0 f x = ox (f x) (fn () => ())
+      fun o1 f x = ox (f x) (fn a => fn () => (a))
+      fun o2 f x = ox (f x) (fn a => fn b => fn () => (a, b))
+      fun o3 f x = ox (f x) (fn a => fn b => fn c => fn () => (a, b, c))
+      fun o4 f x = ox (f x) (fn a => fn b => fn c => fn d => fn () => (a, b, c, d))
+      fun o5 f x = ox (f x) (fn a => fn b => fn c => fn d => fn e => fn () => (a, b, c, d, e))
    end
-
 (*
 open SQL
 val db = Prim.openDB "test.db"
-val Q : real -> string -> int -> unit -> (string -> string -> bool) option -> bool option =
-   execute db "select (a"oS", b"oS") from table where x="iR" and y="iS" and z="iI";" $
+val Q : real * string * int -> unit -> (string * string) option =
+   o2 (i3 (execute db "select (a"oS", b"oS") from table where x="iR" and y="iS" and z="iI";" $))
 *)