[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