[MLton-commit] r5165
Wesley Terpstra
wesley at mlton.org
Sun Feb 11 11:10:45 PST 2007
use tupled arguments
----------------------------------------------------------------------
U mltonlib/trunk/ca/terpstra/sqlite3/fold.sig
U mltonlib/trunk/ca/terpstra/sqlite3/fold.sml
A mltonlib/trunk/ca/terpstra/sqlite3/pair.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/sqlite.sig
U mltonlib/trunk/ca/terpstra/sqlite3/template.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/ca/terpstra/sqlite3/fold.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/fold.sig 2007-02-11 02:20:54 UTC (rev 5164)
+++ mltonlib/trunk/ca/terpstra/sqlite3/fold.sig 2007-02-11 19:10:45 UTC (rev 5165)
@@ -3,11 +3,11 @@
*)
signature FOLD =
sig
- type ('a, 'b, 'c, 'd, 'e) t
+ type ('a, 'b, 'c, 'd) t
type ('a1, 'a2, 'b, 'c, 'd) step0
type ('a11, 'a12, 'a2, 'b, 'c, 'd) step1
- val fold: 'a * ('b -> 'c) -> ('a, 'b, 'c, 'd, 'e) t
+ val fold: 'a * ('b -> 'c) -> ('a, 'b, 'c, 'd) t
val step0: ('a1 -> 'a2) -> ('a1, 'a2, 'b, 'c, 'd) step0
val step1: ('a11 * 'a12 -> 'a2) -> ('a11, 'a12, 'a2, 'b, 'c, 'd) step1
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/fold.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/fold.sml 2007-02-11 02:20:54 UTC (rev 5164)
+++ mltonlib/trunk/ca/terpstra/sqlite3/fold.sml 2007-02-11 19:10:45 UTC (rev 5165)
@@ -1,26 +1,14 @@
(* Shamelessly stolen from Vesa *)
fun $ (a, f) = f a
-structure Fold =
+structure Fold : FOLD =
struct
type ('a, 'b, 'c, 'd) step = 'a * ('b -> 'c) -> 'd
- type ('a, 'b, 'c, 'd, 'e) t = ('a, 'b, 'c, 'd) step -> 'd
- type ('a1, 'a2, 'b, 'c, 'd) step0 = ('a1, 'b, 'c, ('a2, 'b, 'c, 'd, unit) t) step
- type ('a11, 'a12, 'a2, 'b, 'c, 'd) step1 = ('a12, 'b, 'c, 'a11 -> ('a2, 'b, 'c, 'd, unit) t) step
+ type ('a, 'b, 'c, 'd) t = ('a, 'b, 'c, 'd) step -> 'd
+ type ('a1, 'a2, 'b, 'c, 'd) step0 = ('a1, 'b, 'c, ('a2, 'b, 'c, 'd) t) step
+ type ('a11, 'a12, 'a2, 'b, 'c, 'd) step1 = ('a12, 'b, 'c, 'a11 -> ('a2, 'b, 'c, 'd) t) step
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 : FOLD =
- struct
- (* Need help cleaning up this disaster *)
- type ('a, 'b, 'c, 'd, 'e) t = (('b -> 'c) * (('a -> 'd) -> 'd) -> 'e) -> 'e
- type ('a1, 'a2, 'b, 'c, 'd) step0 = ('a2 -> 'b) * 'c -> (('a1 -> 'b) * 'c -> 'd) -> 'd
- type ('a11, 'a12, 'a2, 'b, 'c, 'd) step1 = ('a2 -> 'b) * 'c -> 'a11 -> (('a12 -> 'b) * 'c -> 'd) -> 'd
-
- fun fold (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
Added: mltonlib/trunk/ca/terpstra/sqlite3/pair.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/pair.sml 2007-02-11 02:20:54 UTC (rev 5164)
+++ mltonlib/trunk/ca/terpstra/sqlite3/pair.sml 2007-02-11 19:10:45 UTC (rev 5165)
@@ -0,0 +1,2 @@
+datatype ('a, 'b) pair = & of 'a * 'b
+infix &
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-11 02:20:54 UTC (rev 5164)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-11 19:10:45 UTC (rev 5165)
@@ -1,7 +1,7 @@
signature SQL =
sig
type db
- type ('a, 'b) query
+ type 'a query
type column = { name: string }
exception Retry of string
@@ -11,12 +11,17 @@
val openDB: string -> db
val closeDB: db -> unit
- val close: ('a, 'b) query -> unit
- val meta: ('a, 'b) query -> column vector
+ val close: 'a query -> unit
+ val meta: 'a query -> column vector
- val step: 'a -> ('a, 'b) query -> 'b option
- val map: 'a -> ('a, 'b) query -> 'b vector
+ val step: 'a query -> 'a option
+ val map: ('a -> 'b) -> 'a query -> 'b vector
+ val app: ('a -> unit) -> 'a query -> unit
+ (* convenience functions *)
+ val pull: 'a query -> 'a vector
+ val exec: unit query -> unit
+
datatype storage = INTEGER of Int64.int
| REAL of real
| STRING of string
@@ -28,39 +33,47 @@
* local
* open SQL.Template
* in
- * val T1 : SQL.db -> int -> string -> (string -> real -> out, out) query
- * = query "select (a, b) from table where x="iI" and y="iS";" oS oR $
+ * val T1 = query "select (a, b) from table 1where x="iI" and y="iS";" oS oR $
+ * val T2 = query "insert into table2 values (4, 6);" $
* end
+ * ...
+ * val Q1 = T1 (db & 6 & "sdfs")
+ * val Q2 = T2 db
+ *
+ * val () = SQL.app (fn (x & y) => ...) Q1
+ * val () = SQL.exec Q2
*)
structure Template :
sig
- type ('o, 'of, 'i, 'r) acc
+ type ('i, 'o, 'x, 'y) acc
+ type ('v, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output = (('i, 'o, 'v, 'x) acc, ('i, 'x, 'y, ('x, 'y) pair) acc, 'a, 'b, 'c) Fold.step0
+ type ('v, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input = (string, ('i, 'o, 'x, 'y) acc, (('i, 'v) pair, 'o, 'x, 'y) acc, 'a, 'b, 'c) Fold.step1
- val query: string -> (('r, 'of, ('of, 'r) query, 'r) acc, ('of, 'of, 'i, 'r) acc, db -> 'i, 'y, 'z) Foldr.t
+ val query: string -> ((db, unit, 'a, 'a) acc, ('i, 'o, 'x, 'y) acc, 'i -> 'o query, 'z) Fold.t
val $ : 'a * ('a -> 'b) -> 'b
+ (* Convert the next column to the desired type *)
+ val oB: (Word8Vector.vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oR: (real, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oI: (int, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oZ: (Int64.int, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oS: (string, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oX: (storage, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+
(* Convert all the columns to the desired type in a vector *)
- val oAB: (('o, 'of, 'i, 'r) acc, (Word8Vector.vector vector -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
- val oAR: (('o, 'of, 'i, 'r) acc, (real vector -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
- val oAI: (('o, 'of, 'i, 'r) acc, (int vector -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
- val oAZ: (('o, 'of, 'i, 'r) acc, (Int64.int vector -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
- val oAS: (('o, 'of, 'i, 'r) acc, (string vector -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
- val oAX: (('o, 'of, 'i, 'r) acc, (storage vector -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
+ val oAB: (Word8Vector.vector vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oAR: (real vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oAI: (int vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oAZ: (Int64.int vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oAS: (string vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
+ val oAX: (storage vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output
- (* Convert the next column to the desired type *)
- val oB: (('o, 'of, 'i, 'r) acc, (Word8Vector.vector -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
- val oR: (('o, 'of, 'i, 'r) acc, (real -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
- val oI: (('o, 'of, 'i, 'r) acc, (int -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
- val oZ: (('o, 'of, 'i, 'r) acc, (Int64.int -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
- val oS: (('o, 'of, 'i, 'r) acc, (string -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
- val oX: (('o, 'of, 'i, 'r) acc, (storage -> 'o, 'of, 'i, 'r) acc, 'x, 'y, 'z) Foldr.step0
-
(* Use a variable of the named type in the SQL statement *)
- val iB: (string, ('o, 'of, 'i, 'r) acc, ('o, 'of, Word8Vector.vector -> 'i, 'r) acc, 'x, 'y, 'z) Foldr.step1
- val iR: (string, ('o, 'of, 'i, 'r) acc, ('o, 'of, real -> 'i, 'r) acc, 'x, 'y, 'z) Foldr.step1
- val iI: (string, ('o, 'of, 'i, 'r) acc, ('o, 'of, int -> 'i, 'r) acc, 'x, 'y, 'z) Foldr.step1
- val iZ: (string, ('o, 'of, 'i, 'r) acc, ('o, 'of, Int64.int -> 'i, 'r) acc, 'x, 'y, 'z) Foldr.step1
- val iS: (string, ('o, 'of, 'i, 'r) acc, ('o, 'of, string -> 'i, 'r) acc, 'x, 'y, 'z) Foldr.step1
- val iX: (string, ('o, 'of, 'i, 'r) acc, ('o, 'of, storage -> 'i, 'r) acc, 'x, 'y, 'z) Foldr.step1
+ val iB: (Word8Vector.vector, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
+ val iR: (real, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
+ val iI: (int, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
+ val iZ: (Int64.int, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
+ val iS: (string, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
+ val iX: (storage, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input
end
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-11 02:20:54 UTC (rev 5164)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-11 19:10:45 UTC (rev 5165)
@@ -1,7 +1,7 @@
structure SQL :> SQL =
struct
type db = Prim.db
- type ('a, 'b) query = Prim.query * ('a -> 'b)
+ type 'a query = Prim.query * (Prim.query -> 'a)
type column = Prim.column
exception Retry = Prim.Retry
@@ -15,20 +15,33 @@
fun close (q, _) = Prim.finalize q
fun meta (q, _) = Prim.meta q
- fun step f (q, exec) =
+ fun step (q, oF) =
if Prim.step q
- then SOME (exec f)
+ then SOME (oF q)
else (Prim.reset q; NONE)
- fun map f (q, exec) =
+ fun map f (q, oF) =
let
fun helper l =
if Prim.step q
- then helper (exec f :: l)
+ then helper (f (oF q) :: l)
else (Prim.reset q; Vector.fromList (List.rev l))
in
helper []
end
+ fun app f (q, oF) =
+ let
+ fun helper () =
+ if Prim.step q
+ then (f (oF q); helper ())
+ else Prim.reset q
+ in
+ helper ()
+ end
+
+ fun pull q = map (fn x => x) q
+ fun exec q = app (fn () => ()) q
+
structure Template = Template
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb 2007-02-11 02:20:54 UTC (rev 5164)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb 2007-02-11 19:10:45 UTC (rev 5165)
@@ -12,8 +12,12 @@
fold.sig
fold.sml
- template.sml
in
+ pair.sml
sql.sig
- sql.sml
+ local
+ template.sml
+ in
+ sql.sml
+ end
end
Deleted: mltonlib/trunk/ca/terpstra/sqlite3/sqlite.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sqlite.sig 2007-02-11 02:20:54 UTC (rev 5164)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sqlite.sig 2007-02-11 19:10:45 UTC (rev 5165)
@@ -1,4 +0,0 @@
-signature SQLITE =
- sig
- type db
- end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/template.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/template.sml 2007-02-11 02:20:54 UTC (rev 5164)
+++ mltonlib/trunk/ca/terpstra/sqlite3/template.sml 2007-02-11 19:10:45 UTC (rev 5165)
@@ -1,32 +1,38 @@
structure Template =
struct
- fun outputEnds (_, _, r) = r
- fun inputEnds ((oF, db, q), _, b) =
- let
- val q = Prim.prepare (db, q)
- val () = b q
-
- fun exec f = oF (q, 0, f)
- in
- (q, exec)
- end
+ type 'a oF = Prim.query -> 'a
+ type ('b, 'c) oN = Prim.query * (unit -> 'b) -> 'c
+ type 'd iF = 'd * string -> Prim.query * int
+ type ('i, 'o, 'x, 'y) acc = string list * 'o oF * ('x, 'y) oN * int * 'i iF
+ type ('v, 'i, 'o, 'x, 'y, 'a, 'b, 'c) output = (('i, 'o, 'v, 'x) acc, ('i, 'x, 'y, ('x, 'y) pair) acc, 'a, 'b, 'c) Fold.step0
+ type ('v, 'i, 'o, 'x, 'y, 'a, 'b, 'c) input = (string, ('i, 'o, 'x, 'y) acc, (('i, 'v) pair, 'o, 'x, 'y) acc, 'a, 'b, 'c) Fold.step1
- type ('o, 'r) oF = Prim.query * int * 'o -> 'r
- type ('of, 'i, 'r) iF = (('of, 'r) oF * Prim.db * string) * int * (Prim.query -> unit) -> 'i
- type ('o, 'of, 'i, 'r) acc = string list * ('o, 'r) oF * ('of, 'i, 'r) iF
+ fun oF0 _ = ()
+ fun oN0 (q, n) = n ()
+ val oI0 = 0
+ fun iF0 (db, qs) = (Prim.prepare (db, qs), 1)
- fun query q =
- Foldr.fold (([], outputEnds, inputEnds),
- fn (ql, oF, iF) => fn db =>
- iF ((oF, db, concat (q::ql)), 1, fn _ => ()))
+ fun query qs = Fold.fold (([qs], oF0, oN0, oI0, iF0),
+ fn (ql, oF, _, _, iF) =>
+ let val qs = concat (rev ql)
+ in fn arg =>
+ case iF (arg, qs) of (q, _) => (q, oF)
+ end)
- (* terminate an execution with this: *)
- val $ = $
+ fun iFx f iF (a & x, qs) = case iF (a, qs) of (q, i) => (f (q, i, x); (q, i+1))
+ fun iMap f = Fold.step1 (fn (qs, (ql, oF, oN, oI, iF)) =>
+ (qs :: "?" :: ql, oF, oN, oI, iFx 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
- (* 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 oMap f = Foldr.step0 (fn (ql, oF, iF) => (ql, oFetch f oF, iF))
+ 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) =>
+ (ql, oFx f (oN, oI), oNx f (oN, oI), oI+1, iF))
fun oB z = oMap Prim.fetchB z
fun oR z = oMap Prim.fetchR z
fun oI z = oMap Prim.fetchI z
@@ -34,10 +40,11 @@
fun oS z = oMap Prim.fetchS z
fun oX z = oMap Prim.fetchX 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 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) =>
+ (ql, oFAx f oN, oNAx f oN, oI, iF))
fun oAB z = oMapA Prim.fetchB z
fun oAR z = oMapA Prim.fetchR z
fun oAI z = oMapA Prim.fetchI z
@@ -45,12 +52,6 @@
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
+ (* terminate an execution with this: *)
+ val $ = $
end
More information about the MLton-commit
mailing list