[MLton-commit] r5148
Wesley Terpstra
wesley at mlton.org
Tue Feb 6 15:02:39 PST 2007
working signatures
----------------------------------------------------------------------
U mltonlib/trunk/ca/terpstra/sqlite3/debug.sml
A mltonlib/trunk/ca/terpstra/sqlite3/fold.sig
U mltonlib/trunk/ca/terpstra/sqlite3/fold.sml
U mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
U mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
U mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
A mltonlib/trunk/ca/terpstra/sqlite3/template.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/ca/terpstra/sqlite3/debug.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/debug.sml 2007-02-06 17:01:55 UTC (rev 5147)
+++ mltonlib/trunk/ca/terpstra/sqlite3/debug.sml 2007-02-06 23:02:23 UTC (rev 5148)
@@ -1,4 +1,4 @@
-functor PrimDebug(P : PRIM) : PRIM =
+functor PrimDebug(P : PRIM) :> PRIM =
struct
open P
Added: mltonlib/trunk/ca/terpstra/sqlite3/fold.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/fold.sig 2007-02-06 17:01:55 UTC (rev 5147)
+++ mltonlib/trunk/ca/terpstra/sqlite3/fold.sig 2007-02-06 23:02:23 UTC (rev 5148)
@@ -0,0 +1,13 @@
+(* Stolen from Vesa, and treated like assembler.
+ * See: http://mlton.org/Fold if you like pain.
+ *)
+signature FOLD =
+ sig
+ type ('a, 'b, 'c, 'd, 'e) 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 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-06 17:01:55 UTC (rev 5147)
+++ mltonlib/trunk/ca/terpstra/sqlite3/fold.sml 2007-02-06 23:02:23 UTC (rev 5148)
@@ -2,15 +2,25 @@
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
+ 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
+
+ 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
+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
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-06 17:01:55 UTC (rev 5147)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-06 23:02:23 UTC (rev 5148)
@@ -1,4 +1,4 @@
-structure Prim : PRIM =
+structure Prim :> PRIM =
struct
type db = MLton.Pointer.t
type query = MLton.Pointer.t
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-06 17:01:55 UTC (rev 5147)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-06 23:02:23 UTC (rev 5148)
@@ -1,4 +1,4 @@
-structure SQL =
+structure SQL : SQL =
struct
type db = Prim.db
type ('a, 'b) query = Prim.query * ('a -> 'b)
@@ -7,69 +7,11 @@
exception Retry = Prim.Retry
exception Abort = Prim.Abort
exception Fail = Prim.Fail
+ datatype storage = datatype Prim.storage
val openDB = Prim.openDB
val closeDB = Prim.closeDB
- 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
-
- fun query q =
- Foldr.foldr (([], outputEnds, inputEnds),
- fn (ql, oF, iF) => fn db =>
- iF ((oF, db, concat (q::ql)), 1, fn _ => ()))
-
- (* terminate an execution with this: *)
- val $ = $
-
- (* 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
-
- (* 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
-
- val tuple0 = ()
- fun tuple1 a = a
- fun tuple2 a b = (a, b)
- fun tuple3 a b c = (a, b, c)
- fun tuple4 a b c d = (a, b, c, d)
- fun tuple5 a b c d e = (a, b, c, d, e)
- fun tuple6 a b c d e f = (a, b, c, d, e, f)
- fun tuple7 a b c d e f g = (a, b, c, d, e, f, g)
- fun tuple8 a b c d e f g h = (a, b, c, d, e, f, g, h)
-
fun close (q, _) = Prim.finalize q
fun meta (q, _) = Prim.meta q
@@ -87,4 +29,6 @@
in
helper []
end
+
+ structure Template = Template
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb 2007-02-06 17:01:55 UTC (rev 5147)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sqlite.mlb 2007-02-06 23:02:23 UTC (rev 5148)
@@ -8,8 +8,12 @@
in
prim.sml
end
+(* debug.sml *) (* wraps all the primitive methods to check execution *)
+
+ fold.sig
fold.sml
-(* debug.sml *)
+ template.sml
in
+ sql.sig
sql.sml
end
Added: mltonlib/trunk/ca/terpstra/sqlite3/template.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/template.sml 2007-02-06 17:01:55 UTC (rev 5147)
+++ mltonlib/trunk/ca/terpstra/sqlite3/template.sml 2007-02-06 23:02:23 UTC (rev 5148)
@@ -0,0 +1,56 @@
+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 ('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 query q =
+ Foldr.fold (([], outputEnds, inputEnds),
+ fn (ql, oF, iF) => fn db =>
+ iF ((oF, db, concat (q::ql)), 1, fn _ => ()))
+
+ (* terminate an execution with this: *)
+ val $ = $
+
+ (* 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 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
+
+ (* 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
+ end
More information about the MLton-commit
mailing list