[MLton-commit] r5217
Wesley Terpstra
wesley at mlton.org
Fri Feb 16 07:23:38 PST 2007
binding aggregate functions now works
----------------------------------------------------------------------
U mltonlib/trunk/ca/terpstra/sqlite3/demo.sml
U mltonlib/trunk/ca/terpstra/sqlite3/function.sml
U mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
U mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
U mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
U mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/ca/terpstra/sqlite3/demo.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/demo.sml 2007-02-16 14:43:20 UTC (rev 5216)
+++ mltonlib/trunk/ca/terpstra/sqlite3/demo.sml 2007-02-16 15:23:37 UTC (rev 5217)
@@ -15,10 +15,14 @@
fun concat (a & b) = a ^ b
fun debug v = Vector.app (fn s => print (s ^ "\n")) v
fun glom (s & i) = if i = 0 then raise SQL.Error "bad integer" else s ^ Int.toString i
+ val sum2 = { init = fn () => 0,
+ step = fn (i, (j & k)) => i+j+k,
+ finish = fn x => x }
val () = SQL.registerFunction (db, "wes", fnS iS iS $ concat)
val () = SQL.registerFunction (db, "debug", fnN iAS $ debug)
val () = SQL.registerFunction (db, "glom", fnS iS iI $ glom)
val () = SQL.registerCollation (db, "sless", String.compare)
+ val () = SQL.registerAggregate (db, "sum2", aggrI iI iI $ sum2)
end
local
Modified: mltonlib/trunk/ca/terpstra/sqlite3/function.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/function.sml 2007-02-16 14:43:20 UTC (rev 5216)
+++ mltonlib/trunk/ca/terpstra/sqlite3/function.sml 2007-02-16 15:23:37 UTC (rev 5217)
@@ -1,18 +1,27 @@
structure Function =
struct
- type t = (Prim.context * Prim.value vector -> unit) * int
+ type scalar = (Prim.context * Prim.value vector -> unit) * int
+ type aggregate = Prim.aggregate * int
+ type ('a, 'b, 'c) folder = {
+ init: unit -> 'a,
+ step: 'a * 'b -> 'a,
+ finish: 'a -> 'c
+ }
+
type 'a iF = Prim.value vector -> 'a
type ('b, 'c) iN = Prim.value vector * (unit -> 'b) -> 'c
type ('a, 'b, 'c) acc = int * 'a iF * ('b, 'c) iN
+ type ('v, 'a, 'b, 'c, 'd, 'e) fnX =
+ ((unit, 'a, 'a) acc, ('b, 'c, 'd) acc, ('b -> 'v) -> scalar, 'e) Fold.t
+ type ('v, 'a, 'b, 'c, 'd, 'e, 'f) aggrX =
+ ((unit, 'a, 'a) acc, ('b, 'c, 'd) acc, ('f, 'b, 'v) folder -> aggregate, 'e) Fold.t
+
type ('v, 'a, 'b, 'c, 'd, 'e, 'f) input =
(('a, 'v, 'b) acc, ('b, 'c, ('b, 'c) pair) acc, 'd, 'e, 'f) Fold.step0
- type ('v, 'a, 'b, 'c, 'd, 'e) fnX =
- ((unit, 'a, 'a) acc, ('b, 'c, 'd) acc, ('b -> 'v) -> t, 'e) Fold.t
type ('v, 'a, 'b, 'c) inputA =
((unit, unit, unit) acc, ('v vector, unit, unit) acc, 'a, 'b, 'c) Fold.step0
-
val iI0 = 0
fun iF0 _ = ()
@@ -29,6 +38,31 @@
fun fnX z = fnMap Prim.resultX z
fun fnN z = fnMap Prim.resultN z
+ fun aggrMap r = Fold.fold ((iI0, iF0, iN0),
+ fn (iI, iF, _) => fn { init, step, finish } =>
+ let
+ fun finish1 c = r (c, finish (init ()))
+ fun step1 x =
+ let
+ val acc = ref (init ())
+ fun stepX (_, v) =
+ (acc := step (!acc, iF v);
+ Prim.AGGREGATE (stepX, finishX))
+ and finishX c = r (c, finish (!acc))
+ in
+ stepX x
+ end
+ in
+ (Prim.AGGREGATE (step1, finish1), iI)
+ end)
+ fun aggrB z = aggrMap Prim.resultB z
+ fun aggrR z = aggrMap Prim.resultR z
+ fun aggrI z = aggrMap Prim.resultI z
+ fun aggrZ z = aggrMap Prim.resultZ z
+ fun aggrS z = aggrMap Prim.resultS z
+ fun aggrX z = aggrMap Prim.resultX z
+ fun aggrN z = aggrMap Prim.resultN z
+
(* terminate an expression with this: *)
val $ = $
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-16 14:43:20 UTC (rev 5216)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-16 15:23:37 UTC (rev 5217)
@@ -80,7 +80,7 @@
val resultX: context * storage -> unit
datatype aggregate =
- AGGR of (context * value vector -> aggregate) * (context -> unit)
+ AGGREGATE of (context * value vector -> aggregate) * (context -> unit)
val createFunction: db * string * (context * value vector -> unit) * int -> unit
val createCollation: db * string * (string * string -> order) -> unit
val createAggregate: db * string * aggregate * int -> unit
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-16 14:43:20 UTC (rev 5216)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-16 15:23:37 UTC (rev 5217)
@@ -291,8 +291,8 @@
(************************************************* Aggregate functions *)
datatype aggregate =
- AGGR of (Context.t * Value.t vector -> aggregate) *
- (Context.t -> unit)
+ AGGREGATE of (Context.t * Value.t vector -> aggregate) *
+ (Context.t -> unit)
val aginit = Buffer.empty ()
val agstep = Buffer.empty ()
fun fetchAggr context =
@@ -318,7 +318,7 @@
fun get i = Value.fromPtr (MLton.Pointer.getPointer (args, i))
val args = Vector.tabulate (numargs, get)
fun error s = Presult_error (context, CStr.fromString s, String.size s)
- val AGGR (step, _) = Buffer.sub (agstep, ids)
+ val AGGREGATE (step, _) = Buffer.sub (agstep, ids)
in
Buffer.update (agstep, ids, step (context, args))
handle Error x => error ("fatal: " ^ x)
@@ -330,7 +330,7 @@
let
val ids = fetchAggr context
fun error s = Presult_error (context, CStr.fromString s, String.size s)
- val AGGR (_, final) = Buffer.sub (agstep, ids)
+ val AGGREGATE (_, final) = Buffer.sub (agstep, ids)
in
final context
handle Error x => error ("fatal: " ^ x)
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-16 14:43:20 UTC (rev 5216)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-16 15:23:37 UTC (rev 5217)
@@ -114,22 +114,36 @@
* fun concat (a & b) = a ^ b
* fun pi () = 3.14159
* fun dump v = Vector.app (fn s => print (s ^ "\n")) v
+ *
+ * val sum2 = { init = fn () => 0,
+ * step = fn (i, (j & k)) => i+j+k,
+ * finish = fn x => x }
* in
* val () = SQL.registerFunction (db, "concat", fnS iS iS $ concat)
* val () = SQL.registerFunction (db, "pi", fnR $ pi)
* val () = SQL.registerFunction (db, "dump", fnN iAS $ dump)
+ * val () = SQL.registerAggregate (db, "sum2", aggrI iI iI $ sum2)
* end
*)
structure Function:
sig
- type t
+ type scalar
+ type aggregate
+ type ('a, 'b, 'c) folder = {
+ init: unit -> 'a,
+ step: 'a * 'b -> 'a,
+ finish: 'a -> 'c
+ }
+
(* don't look at this: *)
type ('a, 'b, 'c) acc
+ type ('v, 'a, 'b, 'c, 'd, 'e) fnX =
+ ((unit, 'a, 'a) acc, ('b, 'c, 'd) acc, ('b -> 'v) -> scalar, 'e) Fold.t
+ type ('v, 'a, 'b, 'c, 'd, 'e, 'f) aggrX =
+ ((unit, 'a, 'a) acc, ('b, 'c, 'd) acc, ('f, 'b, 'v) folder -> aggregate, 'e) Fold.t
type ('v, 'a, 'b, 'c, 'd, 'e, 'f) input =
(('a, 'v, 'b) acc, ('b, 'c, ('b, 'c) pair) acc, 'd, 'e, 'f) Fold.step0
- type ('v, 'a, 'b, 'c, 'd, 'e) fnX =
- ((unit, 'a, 'a) acc, ('b, 'c, 'd) acc, ('b -> 'v) -> t, 'e) Fold.t
type ('v, 'a, 'b, 'c) inputA =
((unit, unit, unit) acc, ('v vector, unit, unit) acc, 'a, 'b, 'c) Fold.step0
@@ -142,6 +156,15 @@
val fnX: (storage, 'a, 'b, 'c, 'd, 'e) fnX
val fnN: (unit, 'a, 'b, 'c, 'd, 'e) fnX
+ (* Return types of the aggregate *)
+ val aggrB: (Word8Vector.vector, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
+ val aggrR: (real, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
+ val aggrI: (int, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
+ val aggrZ: (Int64.int, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
+ val aggrS: (string, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
+ val aggrX: (storage, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
+ val aggrN: (unit, 'a, 'b, 'c, 'd, 'e, 'f) aggrX
+
val $ : 'a * ('a -> 'b) -> 'b
(* Input parameters to the function *)
@@ -161,6 +184,8 @@
val iAX: (storage, 'a, 'b, 'c) inputA
end
- val registerFunction: db * string * Function.t -> unit
+ (* SQL.Error exceptions in callbacks are propogated ok. Others not. *)
+ val registerFunction: db * string * Function.scalar -> unit
+ val registerAggregate: db * string * Function.aggregate -> unit
val registerCollation: db * string * (string * string -> order) -> unit
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-16 14:43:20 UTC (rev 5216)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml 2007-02-16 15:23:37 UTC (rev 5217)
@@ -96,6 +96,7 @@
end
end
- fun registerFunction (db, s, (f, i)) = Prim.createFunction (db, s, f, i)
+ fun registerFunction (db, s, (f, i)) = Prim.createFunction (db, s, f, i)
+ fun registerAggregate (db, s, (a, i)) = Prim.createAggregate(db, s, a, i)
val registerCollation = Prim.createCollation
end
More information about the MLton-commit
mailing list