[MLton-commit] r5206

[Wesley Terpstra]

add collation support
----------------------------------------------------------------------

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/prim.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sig	2007-02-15 17:27:01 UTC (rev 5205)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sig	2007-02-15 17:41:43 UTC (rev 5206)
@@ -79,9 +79,9 @@
       val resultS: context * string -> unit
       val resultX: context * storage -> unit
       
-      val createFunction: db * string * (context * value vector -> unit) * int -> unit
+      val createFunction:  db * string * (context * value vector -> unit) * int -> unit
+      val createCollation: db * string * (string * string -> order) -> unit
 (*
-      val createCollation: db * string * (string * string -> order) option -> unit
       val createAggregate: db * string * ((context * value vector -> unit) *
                                           (context -> unit)) option -> unit
 *)

Modified: mltonlib/trunk/ca/terpstra/sqlite3/prim.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/prim.sml	2007-02-15 17:27:01 UTC (rev 5205)
+++ mltonlib/trunk/ca/terpstra/sqlite3/prim.sml	2007-02-15 17:41:43 UTC (rev 5206)
@@ -56,6 +56,7 @@
       
       (* bind a user function *)
       val Pcreate_function = _import "sqlite3_create_function" : DB.t * CStr.t * int * int * word * FnPtr.t * FnPtr.t * FnPtr.t -> int;
+      val Pcreate_collation = _import "sqlite3_create_collation" : DB.t * CStr.t * int * word * FnPtr.t -> int;
       val Puser_data = _import "sqlite3_user_data" : Context.t -> word;
       
       (* fetch user function values *)
@@ -262,15 +263,14 @@
       type callback = Context.t * Value.t vector -> unit
       
       (* !!! Space leak !!! *)
-      val cfns = Buffer.empty ()
-      
+      val fnt = Buffer.empty ()
       fun fnCallback (context, numargs, args) =
          let
-            val cfn = Buffer.sub (cfns, Word.toInt (Puser_data context))
+            val f = Buffer.sub (fnt, Word.toInt (Puser_data context))
             fun get i = Value.fromPtr (MLton.Pointer.getPointer (args, i))
             val args = Vector.tabulate (numargs, get)
          in
-            cfn (context, args)
+            f (context, args)
          end
       val () = _export "mlton_sqlite3_ufnhook" : (Context.t * int * MLton.Pointer.t -> unit) -> unit;
                   fnCallback
@@ -283,8 +283,26 @@
 *)
       fun createFunction (db, name, f, n) =
              code (db, Pcreate_function (db, CStr.fromString name, n, 1, 
-                                         Word.fromInt (Buffer.push (cfns, f)),
+                                         Word.fromInt (Buffer.push (fnt, f)),
                                          fnCallbackPtr, FnPtr.null, FnPtr.null))
+
+      val colt = Buffer.empty ()
+      fun colCallback (uarg, s1l, s1p, s2l, s2p) =
+         let
+            val col = Buffer.sub (colt, Word.toInt uarg)
+         in
+            case col (CStr.toStringLen (s1p, s1l), CStr.toStringLen (s2p, s2l)) of
+               LESS => ~1
+             | EQUAL => 0
+             | GREATER => 1
+         end
+      val () = _export "mlton_sqlite3_colhook" : (word * int * CStr.out * int * CStr.out -> int) -> unit;
+                  colCallback
+      val colCallbackPtr = _address "mlton_sqlite3_colhook" : FnPtr.t;
+      fun createCollation (db, name, f) =
+             code (db, Pcreate_collation (db, CStr.fromString name, 1,
+                                          Word.fromInt (Buffer.push (colt, f)),
+                                          colCallbackPtr))
       
       type db = DB.t
       type query = Query.t

Modified: mltonlib/trunk/ca/terpstra/sqlite3/sql.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/sqlite3/sql.sig	2007-02-15 17:27:01 UTC (rev 5205)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sig	2007-02-15 17:41:43 UTC (rev 5206)
@@ -152,7 +152,5 @@
          end
       
       val registerFunction:  db * string * Function.t -> 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-15 17:27:01 UTC (rev 5205)
+++ mltonlib/trunk/ca/terpstra/sqlite3/sql.sml	2007-02-15 17:41:43 UTC (rev 5206)
@@ -97,4 +97,5 @@
       end
       
       fun registerFunction (db, s, (f, i)) = Prim.createFunction (db, s, f, i)
+      val registerCollation = Prim.createCollation
    end