[MLton-commit] r5207
Wesley Terpstra
wesley at mlton.org
Thu Feb 15 14:39:15 PST 2007
add variadic functions
----------------------------------------------------------------------
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
----------------------------------------------------------------------
Modified: mltonlib/trunk/ca/terpstra/sqlite3/demo.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/demo.sml 2007-02-15 17:41:43 UTC (rev 5206)
+++ mltonlib/trunk/ca/terpstra/sqlite3/demo.sml 2007-02-15 22:39:14 UTC (rev 5207)
@@ -14,6 +14,10 @@
in
val M1 : t = fnS iS iS $ (fn (a & b) => a ^ b)
val () = SQL.registerFunction (db, "wes", M1)
+ val M2 : t = fnR iAS $ (fn v => (Vector.app (fn s => print (s ^ "\n")) v; 0.0))
+ val () = SQL.registerFunction (db, "debug", M2)
+ fun glom (s & i) = s ^ Int.toString i
+ val () = SQL.registerFunction (db, "glom", fnS iS iI $ glom)
end
local
Modified: mltonlib/trunk/ca/terpstra/sqlite3/function.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/function.sml 2007-02-15 17:41:43 UTC (rev 5206)
+++ mltonlib/trunk/ca/terpstra/sqlite3/function.sml 2007-02-15 22:39:14 UTC (rev 5207)
@@ -2,14 +2,17 @@
struct
type t = (Prim.context * Prim.value vector -> unit) * int
- type 'a oF = Prim.value vector -> 'a
- type ('b, 'c) oN = Prim.value vector * (unit -> 'b) -> 'c
- type ('a, 'b, 'c) acc = int * 'a oF * ('b, 'c) oN
+ 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, '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 _ = ()
@@ -24,6 +27,7 @@
fun fnZ z = fnMap Prim.resultZ z
fun fnS z = fnMap Prim.resultS z
fun fnX z = fnMap Prim.resultX z
+ fun fnN z = fnMap Prim.resultN z
(* terminate an expression with this: *)
val $ = $
@@ -38,4 +42,14 @@
fun iZ z = iMap Prim.valueZ z
fun iS z = iMap Prim.valueS z
fun iX z = iMap Prim.valueX z
+
+ fun iAFx f v = Vector.map f v
+ fun iANx iF (v, n) = case iF v of () => () (* plug the type *)
+ fun iAMap f = Fold.step0 (fn (_, iF, _) => (~1, iAFx f, iANx iF))
+ fun iAB z = iAMap Prim.valueB z
+ fun iAR z = iAMap Prim.valueR z
+ fun iAI z = iAMap Prim.valueI z
+ fun iAZ z = iAMap Prim.valueZ z
+ fun iAS z = iAMap Prim.valueS z
+ fun iAX z = iAMap Prim.valueX z
end
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-15 17:41:43 UTC (rev 5206)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sig 2007-02-15 22:39:14 UTC (rev 5207)
@@ -36,7 +36,7 @@
val bindR: query * int * real -> unit
val bindI: query * int * int -> unit
val bindZ: query * int * Int64.int -> unit
- val bindN: query * int -> unit
+ val bindN: query * int * unit -> unit
val bindS: query * int * string -> unit
val bindX: query * int * storage -> unit
@@ -75,7 +75,7 @@
val resultR: context * real -> unit
val resultI: context * int -> unit
val resultZ: context * Int64.int -> unit
- val resultN: context -> unit
+ val resultN: context * unit -> unit
val resultS: context * string -> unit
val resultX: context * storage -> unit
Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-15 17:41:43 UTC (rev 5206)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml 2007-02-15 22:39:14 UTC (rev 5207)
@@ -175,14 +175,14 @@
fun bindR (q, i, d) = wrap (q, Pbind_double (q, i, d))
fun bindI (q, i, z) = wrap (q, Pbind_int (q, i, z))
fun bindZ (q, i, z) = wrap (q, Pbind_int64 (q, i, z))
- fun bindN (q, i) = wrap (q, Pbind_null (q, i))
+ fun bindN (q, i,()) = wrap (q, Pbind_null (q, i))
fun bindS (q, i, s) = wrap (q, Pbind_text (q, i, CStr.fromString s, String.size s, PTRANSIENT))
fun bindX (q, i, INTEGER z) = bindZ (q, i, z)
| bindX (q, i, REAL r) = bindR (q, i, r)
| bindX (q, i, STRING s) = bindS (q, i, s)
| bindX (q, i, BLOB b) = bindB (q, i, b)
- | bindX (q, i, NULL) = bindN (q, i)
+ | bindX (q, i, NULL) = bindN (q, i, ())
fun cols q = Pcolumn_count q
@@ -251,14 +251,14 @@
fun resultR (c, d) = Presult_double (c, d)
fun resultI (c, z) = Presult_int (c, z)
fun resultZ (c, z) = Presult_int64 (c, z)
- fun resultN c = Presult_null c
+ fun resultN (c,()) = Presult_null c
fun resultS (c, s) = Presult_text (c, CStr.fromString s, String.size s, PTRANSIENT)
fun resultX (c, INTEGER z) = resultZ (c, z)
| resultX (c, REAL r) = resultR (c, r)
| resultX (c, STRING s) = resultS (c, s)
| resultX (c, BLOB b) = resultB (c, b)
- | resultX (c, NULL) = resultN c
+ | resultX (c, NULL) = resultN (c, ())
type callback = Context.t * Value.t vector -> unit
Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-15 17:41:43 UTC (rev 5206)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sig 2007-02-15 22:39:14 UTC (rev 5207)
@@ -126,6 +126,8 @@
(('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
(* Return types of the function *)
val fnB: (Word8Vector.vector, 'a, 'b, 'c, 'd, 'e) fnX
@@ -134,6 +136,7 @@
val fnZ: (Int64.int, 'a, 'b, 'c, 'd, 'e) fnX
val fnS: (string, 'a, 'b, 'c, 'd, 'e) fnX
val fnX: (storage, 'a, 'b, 'c, 'd, 'e) fnX
+ val fnN: (unit, 'a, 'b, 'c, 'd, 'e) fnX
val $ : 'a * ('a -> 'b) -> 'b
@@ -145,10 +148,13 @@
val iS: (string, 'a, 'b, 'c, 'd, 'e, 'f) input
val iX: (storage, 'a, 'b, 'c, 'd, 'e, 'f) input
-(*
(* Variadic functions *)
- val iAB: ...
-*)
+ val iAB: (Word8Vector.vector, 'a, 'b, 'c) inputA
+ val iAR: (real, 'a, 'b, 'c) inputA
+ val iAI: (int, 'a, 'b, 'c) inputA
+ val iAZ: (Int64.int, 'a, 'b, 'c) inputA
+ val iAS: (string, 'a, 'b, 'c) inputA
+ val iAX: (storage, 'a, 'b, 'c) inputA
end
val registerFunction: db * string * Function.t -> unit
More information about the MLton-commit
mailing list