# 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 +++++++++++++++++++++++++++++++++++++++++++
xen-api-libs.hg-17.patch
Description: Text Data
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|
Home