[MLton-commit] r5141

[Wesley Terpstra]

use fold to allow multiple input and output arguments
----------------------------------------------------------------------

A   mltonlib/trunk/ca/terpstra/sqlite3/fold.sml
U   mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
U   mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
A   mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
U   mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb

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

Added: mltonlib/trunk/ca/terpstra/sqlite3/fold.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/fold.sml	2007-02-06 00:16:52 UTC (rev 5140)
+++ mltonlib/trunk/ca/terpstra/sqlite3/fold.sml	2007-02-06 00:55:41 UTC (rev 5141)
@@ -0,0 +1,16 @@
+(* Shamelessly stolen from Vesa *)
+
+fun $ (a, f) = f a
+structure Fold =
+  struct
+    fun fold (a, f) g = g (a, f)
+    fun step0 h (a, f) = fold (h a, f)
+    fun step1 h (a, f) b = fold (h (b, a), f)
+  end
+
+structure Foldr =
+  struct
+    fun foldr (a, f) = Fold.fold (f, fn g => g a)
+    fun step0 h = Fold.step0 (fn g => g o h)
+    fun step1 h = Fold.step1 (fn (b, g) => g o (fn a => h (b, a)))
+  end

Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sig	2007-02-06 00:16:52 UTC (rev 5140)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sig	2007-02-06 00:55:41 UTC (rev 5141)
@@ -16,7 +16,7 @@
       
       val prepare:  db * string -> query
       val finalize: query -> unit
-      val step:     query -> unit
+      val step:     query -> bool
       
       datatype storage = INTEGER of Int64.int
                        | REAL of real

Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml	2007-02-06 00:16:52 UTC (rev 5140)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml	2007-02-06 00:55:41 UTC (rev 5141)
@@ -129,7 +129,11 @@
          code (Pdb_handle q, r)
       
       fun finalize q = wrap (q, Pfinalize q)
-      fun step q = wrap (q, Pstep q)
+      fun step q = 
+         case (Pstep q) of
+            100 => true  (* #define SQLITE_ROW         100  /* sqlite_step() has another row ready */ *)
+          | 101 => false (* #define SQLITE_DONE        101  /* sqlite_step() has finished executing */ *)
+          | r => (wrap (q, r); raise Fail "unreachable")
       
       datatype storage = INTEGER of Int64.int
                        | REAL of real

Added: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml	2007-02-06 00:16:52 UTC (rev 5140)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml	2007-02-06 00:55:41 UTC (rev 5141)
@@ -0,0 +1,47 @@
+structure SQL =
+   struct
+      fun iA (oF, b, (db, q), _) () =
+         let
+            val q = Prim.prepare (db, q)
+            val () = b q
+            
+            fun exec NONE = (Prim.finalize q; NONE)
+              | exec (SOME f) =
+                   if Prim.step q 
+                   then SOME (oF (q, f, 0)) 
+                   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))
+      
+      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
+      
+      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
+   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";" $
+*)

Modified: mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb	2007-02-06 00:16:52 UTC (rev 5140)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb	2007-02-06 00:55:41 UTC (rev 5141)
@@ -8,5 +8,7 @@
    in
       prim.sml
    end
+   fold.sml
+   sql.sml
 in
 end