Xen devel - Nov 2012 - [PATCH 07 of 15] libxl: ocaml: support for KeyedUnion in the bindings generator

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID 0cf342afa9e6b506fad68346cb3a1207030372eb
# Parent  f618acdeea1bf60b3b68da4062de018d8162fe8c
libxl: ocaml: support for KeyedUnion in the bindings generator.

A KeyedUnion consists of two fields in the containing struct. First an
enum field ("e") used as a descriminator and second a union
("u")
containing potentially anonymous structs associated with each enum
value.

We map the anonymous structs to structs named after the descriminator
field ("e") and the specific enum values. We then declare an ocaml
variant type name e__union mapping each enum value to its associated
struct.

So given IDL:

 foo = Enumeration("foo",
	(0, "BAR"),
	(1, "BAZ"),
 s = Struct("s", [
        ("u", KeyedUnion(none, foo, "blargle", [
		("bar", Struct(...xxx...)),
		("baz", Struct(...yyy...)),
	])),
 ])

We generate C:

 enum { FOO, BAR } foo;
 struct s {
 	enum foo blargle;
 	union {
 		struct { ...xxx... } bar;
 		struct { ...yyy... } baz;
 	} u;
 }

and map this to ocaml

 type foo = BAR | BAZ;

 module	s = Struct

 	type blargle_bar = ...xxx...;

 	type blargle_baz = ...yyy...;

 	type blargle__union = Bar of blargle_bar | Baz of blargle_baz;

 	type t  	{
 		blargle : blargle__union;
 	}

These type names are OK because they are already within the namespace
associated with the struct "s".

If the struct assiated with bar is empty then we don''t bother iwht
blargle_bar of "of blargle_bar".

No actually change in the gnerated code since we don''t generated any
KeyedUnions yet.

The actual implementation was inspired by
http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php#ref_constvrnt

Signed-off-by: Ian Campbell <ian.campbell@citrix.com>

diff -r f618acdeea1b -r 0cf342afa9e6 tools/libxl/idl.py
--- a/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
@@ -216,6 +216,9 @@ class Struct(Aggregate):
         kwargs.setdefault(''passby'', PASS_BY_REFERENCE)
         Aggregate.__init__(self, "struct", name, fields, **kwargs)
 
+    def has_fields(self):
+        return len(self.fields) != 0
+
 class Union(Aggregate):
     def __init__(self, name, fields, **kwargs):
         # Generally speaking some intelligence is required to free a
diff -r f618acdeea1b -r 0cf342afa9e6 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
@@ -65,6 +65,8 @@ def ocaml_type_of(ty):
         if not typename:
             raise NotImplementedError("No typename for Builtin %s
(%s)" % (ty.typename, type(ty)))
         return typename
+    elif isinstance(ty,idl.KeyedUnion):
+        return ty.union_name
     elif isinstance(ty,idl.Aggregate):
         return ty.rawname.capitalize() + ".t"
     else:
@@ -76,8 +78,67 @@ def munge_name(name):
     else:
         return name
     
-def ocaml_instance_of(type, name):
-    return "%s : %s" % (munge_name(name), ocaml_type_of(type))
+def ocaml_instance_of_field(f):
+    if isinstance(f.type, idl.KeyedUnion):
+        name = f.type.keyvar.name
+    else:
+        name = f.name
+    return "%s : %s" % (munge_name(name), ocaml_type_of(f.type))
+
+def gen_struct(ty):
+    s = ""
+    for f in ty.fields:
+        if f.type.private:
+            continue
+        x = ocaml_instance_of_field(f)
+        x = x.replace("\n", "\n\t\t")
+        s += "\t\t" + x + ";\n"
+    return s
+
+def gen_ocaml_keyedunions(ty, interface, indent, parent = None):
+    s = ""
+    
+    if ty.rawname is not None:
+        # Non-anonymous types need no special handling
+        pass
+    elif isinstance(ty, idl.KeyedUnion):
+        if parent is None:
+            nparent = ty.keyvar.name
+        else:
+            nparent = parent + "_" + ty.keyvar.name
+
+        for f in ty.fields:
+            if f.type is None: continue
+            if f.type.rawname is not None: continue
+            if isinstance(f.type, idl.Struct) and not f.type.has_fields():
continue
+            s += "\ntype %s_%s =\n" % (nparent,f.name)
+            s += "{\n"
+            s += gen_struct(f.type)
+            s += "}\n"
+
+        name = "%s__union" % ty.keyvar.name
+        s += "\n"
+        s += "type %s = " % name
+        u = []
+        for f in ty.fields:
+            if f.type is None:
+                u.append("%s" % (f.name.capitalize()))
+            elif isinstance(f.type, idl.Struct):
+                if f.type.rawname is not None:
+                    u.append("%s of %s" % (f.name.capitalize(),
f.type.rawname.capitalize()))
+                elif f.type.has_fields():
+                    u.append("%s of %s_%s" % (f.name.capitalize(),
nparent, f.name))
+                else:
+                    u.append("%s" % (f.name.capitalize()))
+            else:
+                raise NotImplementedError("Cannot handle KeyedUnion fields
which are not Structs")
+            
+        s += " | ".join(u) + "\n"
+        ty.union_name = name
+
+    if s == "":
+        return None
+    return s.replace("\n", "\n%s" % indent)
 
 def gen_ocaml_ml(ty, interface, indent=""):
 
@@ -103,16 +164,17 @@ def gen_ocaml_ml(ty, interface, indent="
                 s += "module %s : sig\n" % module_name
             else:
                 s += "module %s = struct\n" % module_name
-            s += "\ttype t =\n"
-            s += "\t{\n"
-            
+                
+        # Handle KeyedUnions...
         for f in ty.fields:
-            if f.type.private:
-                continue
-            x = ocaml_instance_of(f.type, f.name)
-            x = x.replace("\n", "\n\t\t")
-            s += "\t\t" + x + ";\n"
+            ku = gen_ocaml_keyedunions(f.type, interface, "\t")
+            if ku is not None:
+                s += ku
+                s += "\n"
 
+        s += "\ttype t =\n"
+        s += "\t{\n"
+        s += gen_struct(ty)
         s += "\t}\n"
         
         if functions.has_key(ty.rawname):
@@ -164,12 +226,43 @@ def c_val(ty, c, o, indent="", parent = 
             n += 1
         s += "    default: failwith_xl(\"cannot convert value to
%s\", lg); break;\n" % ty.typename
         s += "}"
-    elif isinstance(ty, idl.Aggregate) and (parent is None):
+    elif isinstance(ty, idl.KeyedUnion):
+        s += "{\n"
+        s += "\tif(Is_long(%s)) {\n" % o
+        n = 0
+        s += "\t\tswitch(Int_val(%s)) {\n" % o
+        for f in ty.fields:
+            if f.type is None or not f.type.has_fields():
+                s += "\t\t    case %d: %s = %s; break;\n" % (n,
+                                                    parent + ty.keyvar.name,
+                                                    f.enumname)
+            n += 1
+        s += "\t\t    default: failwith_xl(\"variant handling bug
%s%s (long)\", lg); break;\n" % (parent, ty.keyvar.name)
+        s += "\t\t}\n"
+        s += "\t} else {\n"
+        s += "\t\t/* Is block... */\n"
+        s += "\t\tswitch(Tag_val(%s)) {\n" % o
+        n = 0
+        for f in ty.fields:
+            if f.type is not None and f.type.has_fields():
+                if f.type.private:
+                    continue
+                s += "\t\t    case %d:\n" % (n)
+                s += "\t\t        %s = %s;\n" % (parent +
ty.keyvar.name, f.enumname)
+                (nparent,fexpr) = ty.member(c, f, False)
+                s += "%s" % c_val(f.type, fexpr, o,
indent=indent+"\t\t        ")
+                s += "break;\n"
+            n += 1
+        s += "\t\t    default: failwith_xl(\"variant handling bug
%s%s (block)\", lg); break;\n" % (parent, ty.keyvar.name)
+        s += "\t\t}\n"
+        s += "\t}\n"
+        s += "}"
+    elif isinstance(ty, idl.Aggregate) and (parent is None or ty.rawname is
None):
         n = 0
         for f in ty.fields:
             if f.type.private:
                 continue
-            (nparent,fexpr) = ty.member(c, f, parent is None)
+            (nparent,fexpr) = ty.member(c, f, ty.rawname is not None)
             s += "%s\n" % c_val(f.type, fexpr, "Field(%s,
%d)" % (o,n), parent=nparent)
             n = n + 1
     else:
@@ -191,8 +284,8 @@ def gen_c_val(ty, indent=""):
     s += "}\n"
     
     return s.replace("\n", "\n%s" % indent)
-
-def ocaml_Val(ty, o, c, indent="", parent = None):
+    
+def ocaml_Val(ty, o, c, indent="", parent = None, struct_tag = None):
     s = indent
     if isinstance(ty,idl.UInt):
         if ty.width in [8, 16]:
@@ -231,11 +324,39 @@ def ocaml_Val(ty, o, c, indent="", paren
             n += 1
         s += "    default: failwith_xl(\"cannot convert value from
%s\", lg); break;\n" % ty.typename
         s += "}"
-    elif isinstance(ty,idl.Aggregate) and (parent is None):
+    elif isinstance(ty, idl.KeyedUnion):
+        n = 0
+        s += "switch(%s) {\n" % (parent + ty.keyvar.name)
+        for f in ty.fields:
+            s += "\t    case %s:\n" % f.enumname
+            if f.type is None:
+                s += "\t        /* %d: None */\n" % n
+                s += "\t        %s = Val_long(%d);\n" % (o,n)
+            elif not f.type.has_fields():
+                s += "\t        /* %d: Long */\n" % n
+                s += "\t        %s = Val_long(%d);\n" % (o,n)
+            else:
+                s += "\t        /* %d: Block */\n" % n
+                (nparent,fexpr) = ty.member(c, f, parent is None)
+                s += ocaml_Val(f.type, o, fexpr, struct_tag = n,
indent="\t        ", parent=nparent)
+                s += "\n"
+                #s += "\t        %s = caml_alloc(%d,%d);\n" %
(o,len(f.type.fields),n)
+            s += "\t        break;\n"
+            n += 1
+        s += "\t    default: failwith_xl(\"cannot convert value from
%s\", lg); break;\n" % ty.typename
+        s += "\t}"
+    elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is
None):
         s += "{\n"
-        s += "\tvalue %s_field;\n" % ty.rawname
+        if ty.rawname is None:
+            fn = "anon_field"
+        else:
+            fn = "%s_field" % ty.rawname
+        s += "\tvalue %s;\n" % fn
         s += "\n"
-        s += "\t%s = caml_alloc_tuple(%d);\n" % (o, len(ty.fields))
+        if struct_tag is not None:
+            s += "\t%s = caml_alloc(%d,%d);\n" % (o, len(ty.fields),
struct_tag)
+        else:
+            s += "\t%s = caml_alloc_tuple(%d);\n" % (o,
len(ty.fields))
         
         n = 0
         for f in ty.fields:
@@ -245,8 +366,8 @@ def ocaml_Val(ty, o, c, indent="", paren
             (nparent,fexpr) = ty.member(c, f, parent is None)
 
             s += "\n"
-            s += "\t%s\n" % ocaml_Val(f.type, "%s_field" %
ty.rawname, ty.pass_arg(fexpr, c), parent=nparent)
-            s += "\tStore_field(%s, %d, %s);\n" % (o, n,
"%s_field" % ty.rawname)
+            s += "\t%s\n" % ocaml_Val(f.type, fn, ty.pass_arg(fexpr,
c), parent=nparent)
+            s += "\tStore_field(%s, %d, %s);\n" % (o, n, fn)
             n = n + 1
         s += "}"
     else:

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node
ID
> 0cf342afa9e6b506fad68346cb3a1207030372eb
> # Parent  f618acdeea1bf60b3b68da4062de018d8162fe8c
> libxl: ocaml: support for KeyedUnion in the bindings generator.
> 
> A KeyedUnion consists of two fields in the containing struct. First an enum
> field ("e") used as a descriminator and second a union
("u") containing
> potentially anonymous structs associated with each enum value.
> 
> We map the anonymous structs to structs named after the descriminator
> field ("e") and the specific enum values. We then declare an
ocaml variant
> type name e__union mapping each enum value to its associated struct.
> 
> So given IDL:
> 
>  foo = Enumeration("foo",
> 	(0, "BAR"),
> 	(1, "BAZ"),
>  s = Struct("s", [
>         ("u", KeyedUnion(none, foo, "blargle", [
> 		("bar", Struct(...xxx...)),
> 		("baz", Struct(...yyy...)),
> 	])),
>  ])
> 
> We generate C:
> 
>  enum { FOO, BAR } foo;
>  struct s {
>  	enum foo blargle;
>  	union {
>  		struct { ...xxx... } bar;
>  		struct { ...yyy... } baz;
>  	} u;
>  }
> 
> and map this to ocaml
> 
>  type foo = BAR | BAZ;
> 
>  module	s = Struct
> 
>  	type blargle_bar = ...xxx...;
> 
>  	type blargle_baz = ...yyy...;
> 
>  	type blargle__union = Bar of blargle_bar | Baz of blargle_baz;
> 
>  	type t >  	{
>  		blargle : blargle__union;
>  	}
> 
> These type names are OK because they are already within the namespace
> associated with the struct "s".
I think this is a useful representation of KeyedUnion types in ocaml.
I''ll play around a bit with this implementation.

Cheers,
Rob
 
> If the struct assiated with bar is empty then we don''t bother iwht
> blargle_bar of "of blargle_bar".
> 
> No actually change in the gnerated code since we don''t generated
any
> KeyedUnions yet.
> 
> The actual implementation was inspired by http://www.linux-
> nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php#ref_constvrnt
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
> 
> diff -r f618acdeea1b -r 0cf342afa9e6 tools/libxl/idl.py
> --- a/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -216,6 +216,9 @@ class Struct(Aggregate):
>          kwargs.setdefault(''passby'', PASS_BY_REFERENCE)
>          Aggregate.__init__(self, "struct", name, fields,
**kwargs)
> 
> +    def has_fields(self):
> +        return len(self.fields) != 0
> +
>  class Union(Aggregate):
>      def __init__(self, name, fields, **kwargs):
>          # Generally speaking some intelligence is required to free a diff
-r
> f618acdeea1b -r 0cf342afa9e6 tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -65,6 +65,8 @@ def ocaml_type_of(ty):
>          if not typename:
>              raise NotImplementedError("No typename for Builtin %s
(%s)" %
> (ty.typename, type(ty)))
>          return typename
> +    elif isinstance(ty,idl.KeyedUnion):
> +        return ty.union_name
>      elif isinstance(ty,idl.Aggregate):
>          return ty.rawname.capitalize() + ".t"
>      else:
> @@ -76,8 +78,67 @@ def munge_name(name):
>      else:
>          return name
> 
> -def ocaml_instance_of(type, name):
> -    return "%s : %s" % (munge_name(name), ocaml_type_of(type))
> +def ocaml_instance_of_field(f):
> +    if isinstance(f.type, idl.KeyedUnion):
> +        name = f.type.keyvar.name
> +    else:
> +        name = f.name
> +    return "%s : %s" % (munge_name(name), ocaml_type_of(f.type))
> +
> +def gen_struct(ty):
> +    s = ""
> +    for f in ty.fields:
> +        if f.type.private:
> +            continue
> +        x = ocaml_instance_of_field(f)
> +        x = x.replace("\n", "\n\t\t")
> +        s += "\t\t" + x + ";\n"
> +    return s
> +
> +def gen_ocaml_keyedunions(ty, interface, indent, parent = None):
> +    s = ""
> +
> +    if ty.rawname is not None:
> +        # Non-anonymous types need no special handling
> +        pass
> +    elif isinstance(ty, idl.KeyedUnion):
> +        if parent is None:
> +            nparent = ty.keyvar.name
> +        else:
> +            nparent = parent + "_" + ty.keyvar.name
> +
> +        for f in ty.fields:
> +            if f.type is None: continue
> +            if f.type.rawname is not None: continue
> +            if isinstance(f.type, idl.Struct) and not f.type.has_fields():
continue
> +            s += "\ntype %s_%s =\n" % (nparent,f.name)
> +            s += "{\n"
> +            s += gen_struct(f.type)
> +            s += "}\n"
> +
> +        name = "%s__union" % ty.keyvar.name
> +        s += "\n"
> +        s += "type %s = " % name
> +        u = []
> +        for f in ty.fields:
> +            if f.type is None:
> +                u.append("%s" % (f.name.capitalize()))
> +            elif isinstance(f.type, idl.Struct):
> +                if f.type.rawname is not None:
> +                    u.append("%s of %s" % (f.name.capitalize(),
> f.type.rawname.capitalize()))
> +                elif f.type.has_fields():
> +                    u.append("%s of %s_%s" %
(f.name.capitalize(), nparent,
> f.name))
> +                else:
> +                    u.append("%s" % (f.name.capitalize()))
> +            else:
> +                raise NotImplementedError("Cannot handle KeyedUnion
> + fields which are not Structs")
> +
> +        s += " | ".join(u) + "\n"
> +        ty.union_name = name
> +
> +    if s == "":
> +        return None
> +    return s.replace("\n", "\n%s" % indent)
> 
>  def gen_ocaml_ml(ty, interface, indent=""):
> 
> @@ -103,16 +164,17 @@ def gen_ocaml_ml(ty, interface, indent="
>                  s += "module %s : sig\n" % module_name
>              else:
>                  s += "module %s = struct\n" % module_name
> -            s += "\ttype t =\n"
> -            s += "\t{\n"
> -
> +
> +        # Handle KeyedUnions...
>          for f in ty.fields:
> -            if f.type.private:
> -                continue
> -            x = ocaml_instance_of(f.type, f.name)
> -            x = x.replace("\n", "\n\t\t")
> -            s += "\t\t" + x + ";\n"
> +            ku = gen_ocaml_keyedunions(f.type, interface, "\t")
> +            if ku is not None:
> +                s += ku
> +                s += "\n"
> 
> +        s += "\ttype t =\n"
> +        s += "\t{\n"
> +        s += gen_struct(ty)
>          s += "\t}\n"
> 
>          if functions.has_key(ty.rawname):
> @@ -164,12 +226,43 @@ def c_val(ty, c, o, indent="", parent > 
n += 1
>          s += "    default: failwith_xl(\"cannot convert value to
%s\", lg);
> break;\n" % ty.typename
>          s += "}"
> -    elif isinstance(ty, idl.Aggregate) and (parent is None):
> +    elif isinstance(ty, idl.KeyedUnion):
> +        s += "{\n"
> +        s += "\tif(Is_long(%s)) {\n" % o
> +        n = 0
> +        s += "\t\tswitch(Int_val(%s)) {\n" % o
> +        for f in ty.fields:
> +            if f.type is None or not f.type.has_fields():
> +                s += "\t\t    case %d: %s = %s; break;\n" % (n,
> +                                                    parent +
ty.keyvar.name,
> +                                                    f.enumname)
> +            n += 1
> +        s += "\t\t    default: failwith_xl(\"variant handling
bug %s%s (long)\",
> lg); break;\n" % (parent, ty.keyvar.name)
> +        s += "\t\t}\n"
> +        s += "\t} else {\n"
> +        s += "\t\t/* Is block... */\n"
> +        s += "\t\tswitch(Tag_val(%s)) {\n" % o
> +        n = 0
> +        for f in ty.fields:
> +            if f.type is not None and f.type.has_fields():
> +                if f.type.private:
> +                    continue
> +                s += "\t\t    case %d:\n" % (n)
> +                s += "\t\t        %s = %s;\n" % (parent +
ty.keyvar.name, f.enumname)
> +                (nparent,fexpr) = ty.member(c, f, False)
> +                s += "%s" % c_val(f.type, fexpr, o,
indent=indent+"\t\t        ")
> +                s += "break;\n"
> +            n += 1
> +        s += "\t\t    default: failwith_xl(\"variant handling
bug %s%s (block)\",
> lg); break;\n" % (parent, ty.keyvar.name)
> +        s += "\t\t}\n"
> +        s += "\t}\n"
> +        s += "}"
> +    elif isinstance(ty, idl.Aggregate) and (parent is None or ty.rawname
is
> None):
>          n = 0
>          for f in ty.fields:
>              if f.type.private:
>                  continue
> -            (nparent,fexpr) = ty.member(c, f, parent is None)
> +            (nparent,fexpr) = ty.member(c, f, ty.rawname is not None)
>              s += "%s\n" % c_val(f.type, fexpr, "Field(%s,
%d)" % (o,n),
> parent=nparent)
>              n = n + 1
>      else:
> @@ -191,8 +284,8 @@ def gen_c_val(ty, indent=""):
>      s += "}\n"
> 
>      return s.replace("\n", "\n%s" % indent)
> -
> -def ocaml_Val(ty, o, c, indent="", parent = None):
> +
> +def ocaml_Val(ty, o, c, indent="", parent = None, struct_tag =
None):
>      s = indent
>      if isinstance(ty,idl.UInt):
>          if ty.width in [8, 16]:
> @@ -231,11 +324,39 @@ def ocaml_Val(ty, o, c, indent="", paren
>              n += 1
>          s += "    default: failwith_xl(\"cannot convert value
from %s\", lg);
> break;\n" % ty.typename
>          s += "}"
> -    elif isinstance(ty,idl.Aggregate) and (parent is None):
> +    elif isinstance(ty, idl.KeyedUnion):
> +        n = 0
> +        s += "switch(%s) {\n" % (parent + ty.keyvar.name)
> +        for f in ty.fields:
> +            s += "\t    case %s:\n" % f.enumname
> +            if f.type is None:
> +                s += "\t        /* %d: None */\n" % n
> +                s += "\t        %s = Val_long(%d);\n" % (o,n)
> +            elif not f.type.has_fields():
> +                s += "\t        /* %d: Long */\n" % n
> +                s += "\t        %s = Val_long(%d);\n" % (o,n)
> +            else:
> +                s += "\t        /* %d: Block */\n" % n
> +                (nparent,fexpr) = ty.member(c, f, parent is None)
> +                s += ocaml_Val(f.type, o, fexpr, struct_tag = n,
indent="\t        ",
> parent=nparent)
> +                s += "\n"
> +                #s += "\t        %s = caml_alloc(%d,%d);\n" %
(o,len(f.type.fields),n)
> +            s += "\t        break;\n"
> +            n += 1
> +        s += "\t    default: failwith_xl(\"cannot convert value
from %s\", lg);
> break;\n" % ty.typename
> +        s += "\t}"
> +    elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is
> None):
>          s += "{\n"
> -        s += "\tvalue %s_field;\n" % ty.rawname
> +        if ty.rawname is None:
> +            fn = "anon_field"
> +        else:
> +            fn = "%s_field" % ty.rawname
> +        s += "\tvalue %s;\n" % fn
>          s += "\n"
> -        s += "\t%s = caml_alloc_tuple(%d);\n" % (o,
len(ty.fields))
> +        if struct_tag is not None:
> +            s += "\t%s = caml_alloc(%d,%d);\n" % (o,
len(ty.fields), struct_tag)
> +        else:
> +            s += "\t%s = caml_alloc_tuple(%d);\n" % (o,
len(ty.fields))
> 
>          n = 0
>          for f in ty.fields:
> @@ -245,8 +366,8 @@ def ocaml_Val(ty, o, c, indent="", paren
>              (nparent,fexpr) = ty.member(c, f, parent is None)
> 
>              s += "\n"
> -            s += "\t%s\n" % ocaml_Val(f.type,
"%s_field" % ty.rawname,
> ty.pass_arg(fexpr, c), parent=nparent)
> -            s += "\tStore_field(%s, %d, %s);\n" % (o, n,
"%s_field" % ty.rawname)
> +            s += "\t%s\n" % ocaml_Val(f.type, fn,
ty.pass_arg(fexpr, c),
> parent=nparent)
> +            s += "\tStore_field(%s, %d, %s);\n" % (o, n, fn)
>              n = n + 1
>          s += "}"
>      else:
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

On Mon, 2012-11-26 at 15:31 +0000, Rob Hoes wrote:
> I think this is a useful representation of KeyedUnion types in ocaml.
> I''ll play around a bit with this implementation.
Thanks, one of the problem I have with these bindings is that although I
can clone and hack ocaml OK I''m not sure what constructs are expected
by
proper ocaml programmers ;-)

Ian.

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node
ID
> 0cf342afa9e6b506fad68346cb3a1207030372eb
> # Parent  f618acdeea1bf60b3b68da4062de018d8162fe8c
> libxl: ocaml: support for KeyedUnion in the bindings generator.
> 
> A KeyedUnion consists of two fields in the containing struct. First an enum
> field ("e") used as a descriminator and second a union
("u") containing
> potentially anonymous structs associated with each enum value.
> 
> We map the anonymous structs to structs named after the descriminator
> field ("e") and the specific enum values. We then declare an
ocaml variant
> type name e__union mapping each enum value to its associated struct.
> 
> So given IDL:
> 
>  foo = Enumeration("foo",
> 	(0, "BAR"),
> 	(1, "BAZ"),
>  s = Struct("s", [
>         ("u", KeyedUnion(none, foo, "blargle", [
> 		("bar", Struct(...xxx...)),
> 		("baz", Struct(...yyy...)),
> 	])),
>  ])
> 
> We generate C:
> 
>  enum { FOO, BAR } foo;
>  struct s {
>  	enum foo blargle;
>  	union {
>  		struct { ...xxx... } bar;
>  		struct { ...yyy... } baz;
>  	} u;
>  }
> 
> and map this to ocaml
> 
>  type foo = BAR | BAZ;
> 
>  module	s = Struct
> 
>  	type blargle_bar = ...xxx...;
> 
>  	type blargle_baz = ...yyy...;
> 
>  	type blargle__union = Bar of blargle_bar | Baz of blargle_baz;
> 
>  	type t >  	{
>  		blargle : blargle__union;
>  	}
> 
> These type names are OK because they are already within the namespace
> associated with the struct "s".
> 
> If the struct assiated with bar is empty then we don''t bother iwht
> blargle_bar of "of blargle_bar".
> 
> No actually change in the gnerated code since we don''t generated
any
> KeyedUnions yet.
> 
> The actual implementation was inspired by http://www.linux-
> nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php#ref_constvrnt
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
This works for me.

Acked-by: Rob Hoes <rob.hoes@citrix.com>
> diff -r f618acdeea1b -r 0cf342afa9e6 tools/libxl/idl.py
> --- a/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -216,6 +216,9 @@ class Struct(Aggregate):
>          kwargs.setdefault(''passby'', PASS_BY_REFERENCE)
>          Aggregate.__init__(self, "struct", name, fields,
**kwargs)
> 
> +    def has_fields(self):
> +        return len(self.fields) != 0
> +
>  class Union(Aggregate):
>      def __init__(self, name, fields, **kwargs):
>          # Generally speaking some intelligence is required to free a diff
-r
> f618acdeea1b -r 0cf342afa9e6 tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -65,6 +65,8 @@ def ocaml_type_of(ty):
>          if not typename:
>              raise NotImplementedError("No typename for Builtin %s
(%s)" %
> (ty.typename, type(ty)))
>          return typename
> +    elif isinstance(ty,idl.KeyedUnion):
> +        return ty.union_name
>      elif isinstance(ty,idl.Aggregate):
>          return ty.rawname.capitalize() + ".t"
>      else:
> @@ -76,8 +78,67 @@ def munge_name(name):
>      else:
>          return name
> 
> -def ocaml_instance_of(type, name):
> -    return "%s : %s" % (munge_name(name), ocaml_type_of(type))
> +def ocaml_instance_of_field(f):
> +    if isinstance(f.type, idl.KeyedUnion):
> +        name = f.type.keyvar.name
> +    else:
> +        name = f.name
> +    return "%s : %s" % (munge_name(name), ocaml_type_of(f.type))
> +
> +def gen_struct(ty):
> +    s = ""
> +    for f in ty.fields:
> +        if f.type.private:
> +            continue
> +        x = ocaml_instance_of_field(f)
> +        x = x.replace("\n", "\n\t\t")
> +        s += "\t\t" + x + ";\n"
> +    return s
> +
> +def gen_ocaml_keyedunions(ty, interface, indent, parent = None):
> +    s = ""
> +
> +    if ty.rawname is not None:
> +        # Non-anonymous types need no special handling
> +        pass
> +    elif isinstance(ty, idl.KeyedUnion):
> +        if parent is None:
> +            nparent = ty.keyvar.name
> +        else:
> +            nparent = parent + "_" + ty.keyvar.name
> +
> +        for f in ty.fields:
> +            if f.type is None: continue
> +            if f.type.rawname is not None: continue
> +            if isinstance(f.type, idl.Struct) and not f.type.has_fields():
continue
> +            s += "\ntype %s_%s =\n" % (nparent,f.name)
> +            s += "{\n"
> +            s += gen_struct(f.type)
> +            s += "}\n"
> +
> +        name = "%s__union" % ty.keyvar.name
> +        s += "\n"
> +        s += "type %s = " % name
> +        u = []
> +        for f in ty.fields:
> +            if f.type is None:
> +                u.append("%s" % (f.name.capitalize()))
> +            elif isinstance(f.type, idl.Struct):
> +                if f.type.rawname is not None:
> +                    u.append("%s of %s" % (f.name.capitalize(),
> f.type.rawname.capitalize()))
> +                elif f.type.has_fields():
> +                    u.append("%s of %s_%s" %
(f.name.capitalize(), nparent,
> f.name))
> +                else:
> +                    u.append("%s" % (f.name.capitalize()))
> +            else:
> +                raise NotImplementedError("Cannot handle KeyedUnion
> + fields which are not Structs")
> +
> +        s += " | ".join(u) + "\n"
> +        ty.union_name = name
> +
> +    if s == "":
> +        return None
> +    return s.replace("\n", "\n%s" % indent)
> 
>  def gen_ocaml_ml(ty, interface, indent=""):
> 
> @@ -103,16 +164,17 @@ def gen_ocaml_ml(ty, interface, indent="
>                  s += "module %s : sig\n" % module_name
>              else:
>                  s += "module %s = struct\n" % module_name
> -            s += "\ttype t =\n"
> -            s += "\t{\n"
> -
> +
> +        # Handle KeyedUnions...
>          for f in ty.fields:
> -            if f.type.private:
> -                continue
> -            x = ocaml_instance_of(f.type, f.name)
> -            x = x.replace("\n", "\n\t\t")
> -            s += "\t\t" + x + ";\n"
> +            ku = gen_ocaml_keyedunions(f.type, interface, "\t")
> +            if ku is not None:
> +                s += ku
> +                s += "\n"
> 
> +        s += "\ttype t =\n"
> +        s += "\t{\n"
> +        s += gen_struct(ty)
>          s += "\t}\n"
> 
>          if functions.has_key(ty.rawname):
> @@ -164,12 +226,43 @@ def c_val(ty, c, o, indent="", parent > 
n += 1
>          s += "    default: failwith_xl(\"cannot convert value to
%s\", lg);
> break;\n" % ty.typename
>          s += "}"
> -    elif isinstance(ty, idl.Aggregate) and (parent is None):
> +    elif isinstance(ty, idl.KeyedUnion):
> +        s += "{\n"
> +        s += "\tif(Is_long(%s)) {\n" % o
> +        n = 0
> +        s += "\t\tswitch(Int_val(%s)) {\n" % o
> +        for f in ty.fields:
> +            if f.type is None or not f.type.has_fields():
> +                s += "\t\t    case %d: %s = %s; break;\n" % (n,
> +                                                    parent +
ty.keyvar.name,
> +                                                    f.enumname)
> +            n += 1
> +        s += "\t\t    default: failwith_xl(\"variant handling
bug %s%s (long)\",
> lg); break;\n" % (parent, ty.keyvar.name)
> +        s += "\t\t}\n"
> +        s += "\t} else {\n"
> +        s += "\t\t/* Is block... */\n"
> +        s += "\t\tswitch(Tag_val(%s)) {\n" % o
> +        n = 0
> +        for f in ty.fields:
> +            if f.type is not None and f.type.has_fields():
> +                if f.type.private:
> +                    continue
> +                s += "\t\t    case %d:\n" % (n)
> +                s += "\t\t        %s = %s;\n" % (parent +
ty.keyvar.name, f.enumname)
> +                (nparent,fexpr) = ty.member(c, f, False)
> +                s += "%s" % c_val(f.type, fexpr, o,
indent=indent+"\t\t        ")
> +                s += "break;\n"
> +            n += 1
> +        s += "\t\t    default: failwith_xl(\"variant handling
bug %s%s (block)\",
> lg); break;\n" % (parent, ty.keyvar.name)
> +        s += "\t\t}\n"
> +        s += "\t}\n"
> +        s += "}"
> +    elif isinstance(ty, idl.Aggregate) and (parent is None or ty.rawname
is
> None):
>          n = 0
>          for f in ty.fields:
>              if f.type.private:
>                  continue
> -            (nparent,fexpr) = ty.member(c, f, parent is None)
> +            (nparent,fexpr) = ty.member(c, f, ty.rawname is not None)
>              s += "%s\n" % c_val(f.type, fexpr, "Field(%s,
%d)" % (o,n),
> parent=nparent)
>              n = n + 1
>      else:
> @@ -191,8 +284,8 @@ def gen_c_val(ty, indent=""):
>      s += "}\n"
> 
>      return s.replace("\n", "\n%s" % indent)
> -
> -def ocaml_Val(ty, o, c, indent="", parent = None):
> +
> +def ocaml_Val(ty, o, c, indent="", parent = None, struct_tag =
None):
>      s = indent
>      if isinstance(ty,idl.UInt):
>          if ty.width in [8, 16]:
> @@ -231,11 +324,39 @@ def ocaml_Val(ty, o, c, indent="", paren
>              n += 1
>          s += "    default: failwith_xl(\"cannot convert value
from %s\", lg);
> break;\n" % ty.typename
>          s += "}"
> -    elif isinstance(ty,idl.Aggregate) and (parent is None):
> +    elif isinstance(ty, idl.KeyedUnion):
> +        n = 0
> +        s += "switch(%s) {\n" % (parent + ty.keyvar.name)
> +        for f in ty.fields:
> +            s += "\t    case %s:\n" % f.enumname
> +            if f.type is None:
> +                s += "\t        /* %d: None */\n" % n
> +                s += "\t        %s = Val_long(%d);\n" % (o,n)
> +            elif not f.type.has_fields():
> +                s += "\t        /* %d: Long */\n" % n
> +                s += "\t        %s = Val_long(%d);\n" % (o,n)
> +            else:
> +                s += "\t        /* %d: Block */\n" % n
> +                (nparent,fexpr) = ty.member(c, f, parent is None)
> +                s += ocaml_Val(f.type, o, fexpr, struct_tag = n,
indent="\t        ",
> parent=nparent)
> +                s += "\n"
> +                #s += "\t        %s = caml_alloc(%d,%d);\n" %
(o,len(f.type.fields),n)
> +            s += "\t        break;\n"
> +            n += 1
> +        s += "\t    default: failwith_xl(\"cannot convert value
from %s\", lg);
> break;\n" % ty.typename
> +        s += "\t}"
> +    elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is
> None):
>          s += "{\n"
> -        s += "\tvalue %s_field;\n" % ty.rawname
> +        if ty.rawname is None:
> +            fn = "anon_field"
> +        else:
> +            fn = "%s_field" % ty.rawname
> +        s += "\tvalue %s;\n" % fn
>          s += "\n"
> -        s += "\t%s = caml_alloc_tuple(%d);\n" % (o,
len(ty.fields))
> +        if struct_tag is not None:
> +            s += "\t%s = caml_alloc(%d,%d);\n" % (o,
len(ty.fields), struct_tag)
> +        else:
> +            s += "\t%s = caml_alloc_tuple(%d);\n" % (o,
len(ty.fields))
> 
>          n = 0
>          for f in ty.fields:
> @@ -245,8 +366,8 @@ def ocaml_Val(ty, o, c, indent="", paren
>              (nparent,fexpr) = ty.member(c, f, parent is None)
> 
>              s += "\n"
> -            s += "\t%s\n" % ocaml_Val(f.type,
"%s_field" % ty.rawname,
> ty.pass_arg(fexpr, c), parent=nparent)
> -            s += "\tStore_field(%s, %d, %s);\n" % (o, n,
"%s_field" % ty.rawname)
> +            s += "\t%s\n" % ocaml_Val(f.type, fn,
ty.pass_arg(fexpr, c),
> parent=nparent)
> +            s += "\tStore_field(%s, %d, %s);\n" % (o, n, fn)
>              n = n + 1
>          s += "}"
>      else:
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel