[Xen-API] [PATCH 15 of 17] [rpc-light] Optimize the way (string * t) list are marshaled

[Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>]

# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
# Date 1262958466 0
# Node ID bca2a17d2f9e9af21773061a902be48f990c4f08
# Parent  a571cd80dcb8a38c72b58bbc05b49cf14409c883
[rpc-light] Optimize the way (string * t) list are marshaled

This bit is necessary to discuss with the SM backend and it is also a nice 
optiomization. Basically, if you have: 'type t = (kk, vv) list with rpc' the 
library will check if value of type 'kk' are marshaled to a string; if yes, 
instead of having a list of stuff, it creates a dictionary which is what the 
python XenAPI bindings are looking for.

Signed-off-by: Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>

diff -r a571cd80dcb8 -r bca2a17d2f9e rpc-light/examples/Makefile
--- a/rpc-light/examples/Makefile       Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/examples/Makefile       Fri Jan 08 13:47:46 2010 +0000
@@ -8,7 +8,8 @@
        phantom \
        xapi \
        option \
-       encoding
+       encoding \
+       dict
 
 EXECS=$(foreach example, $(EXAMPLES), $(example).opt)
 
diff -r a571cd80dcb8 -r bca2a17d2f9e rpc-light/examples/dict.ml
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/rpc-light/examples/dict.ml        Fri Jan 08 13:47:46 2010 +0000
@@ -0,0 +1,12 @@
+type key = string with rpc
+
+type t = (key * float) list with rpc
+
+let _ = 
+       let t = [ "foo", 3. ; "bar", 4. ] in
+       let r = rpc_of_t t in
+       Printf.printf "r = %s\n%!" (Rpc.to_string r);
+
+       let t' = t_of_rpc r in
+       Printf.printf "t = t' : %b\n%!" (t = t');
+       assert (t = t')
diff -r a571cd80dcb8 -r bca2a17d2f9e rpc-light/p4_rpc.ml
--- a/rpc-light/p4_rpc.ml       Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/p4_rpc.ml       Fri Jan 08 13:47:46 2010 +0000
@@ -19,7 +19,13 @@
 open Ast
 open Syntax
 
+
+let is_base = function
+       | "int64" | "int32" | "int" | "flaot" | "string" | "unit" -> true
+       | _ -> false
+
 let rpc_of n = "rpc_of_" ^ n
+
 let of_rpc n = n ^ "_of_rpc"
 
 let rpc_of_polyvar a = "__rpc_of_" ^ a ^ "__"
@@ -126,6 +132,13 @@
        | <:ctyp@loc< option $_$ >> -> true
        | _                         -> false
 
+let is_string _loc key =
+       if key = "string" then
+               <:expr< True >>
+       else if is_base key then
+               <:expr< False >>
+       else <:expr< try let ( _ : $lid:key$ ) = $lid:of_rpc key$ (Rpc.String 
"") in True with [ _ -> False ] >>
+
 (* Conversion ML type -> Rpc.value *)
 module Rpc_of = struct
        
@@ -159,6 +172,23 @@
                | <:ctyp< char >>    -> <:expr< Rpc.Int (Int64.of_int 
(Char.code $id$)) >>
                | <:ctyp< string >>  -> <:expr< Rpc.String $id$ >>
                | <:ctyp< bool >>    -> <:expr< Rpc.Bool $id$ >>
+
+               | <:ctyp< list (string * $t$) >> ->
+                       let nid, pid = new_id _loc in
+                       <:expr<
+                               let dict = List.map (fun (key, $pid$) -> (key, 
$create nid t$)) $id$ in
+                               Rpc.Dict dict >>
+
+               | <:ctyp< list ($lid:key$ * $t$) >> when not (is_base key) ->
+                       let nid1, pid1 = new_id _loc in
+                       let nid2, pid2 = new_id _loc in
+                       <:expr<
+                               let is_a_real_dict = $is_string _loc key$ in
+                               let dict = List.map (fun ($pid1$, $pid2$) -> 
($lid:rpc_of key$ $nid1$, $create nid2 t$)) $id$ in
+                               if is_a_real_dict then
+                                       Rpc.Dict (List.map (fun [ (Rpc.String 
k, v) -> (k, v) | _ -> assert False ]) dict)
+                               else
+                                       Rpc.Enum (List.map (fun (k, v) -> 
Rpc.Enum [k; v] ) dict) >>
 
                | <:ctyp< [< $t$ ] >> | <:ctyp< [> $t$ ] >> | <:ctyp< [= $t$ ] 
>> | <:ctyp< [ $t$ ] >> ->
                        let ids, ctyps = decompose_variants _loc t in
@@ -302,6 +332,26 @@
                | <:ctyp< string >> -> <:expr< match $id$ with [ Rpc.String x 
-> x | $runtime_error name id "String(string)"$ ] >>
                | <:ctyp< bool >>   -> <:expr< match $id$ with [ Rpc.Bool x -> 
x | $runtime_error name id "Bool"$ ] >>
 
+               | <:ctyp< list (string * $t$ ) >> ->
+                       let nid, pid = new_id _loc in
+                       <:expr< match $id$ with [
+                         Rpc.Dict d -> List.map (fun (key, $pid$) -> (key, 
$create name nid t$)) d
+                       | $runtime_error name id "Dict"$ ] >>
+
+               | <:ctyp< list ($lid:key$ * $t$) >> when not (is_base key) ->
+                       let nid, pid = new_id _loc in
+                       <:expr<
+                               let is_a_real_dict = $is_string _loc key$ in
+                               if is_a_real_dict then begin
+                                       match $id$ with [
+                                         Rpc.Dict d -> List.map (fun (key, 
$pid$) -> ($lid:of_rpc key$ (Rpc.String key), $create name nid t$)) d
+                                       | $runtime_error name id "Dict"$ ]
+                               end else begin
+                                       match $id$ with [
+                                         Rpc.Enum e -> List.map (fun $pid$ -> 
$create name nid <:ctyp< ($lid:key$ * $t$) >>$) e
+                                       | $runtime_error name id "Enum"$ ]
+                               end >>
+
                | <:ctyp< [< $t$ ] >> | <:ctyp< [> $t$ ] >> | <:ctyp< [= $t$ ] 
>> | <:ctyp< [ $t$ ] >> ->
                        let ids, ctyps = decompose_variants _loc t in
                        let pattern (n, t) ctyps =
3 files changed, 64 insertions(+), 1 deletion(-)
rpc-light/examples/Makefile |    3 +-
rpc-light/examples/dict.ml  |   12 ++++++++++
rpc-light/p4_rpc.ml         |   50 +++++++++++++++++++++++++++++++++++++++++++

Attachment: xen-api-libs.hg-17.patch
Description: Text Data

_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api