[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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



> # HG changeset patch
> # User Ian Campbell <ijc@xxxxxxxxxxxxxx> # 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@xxxxxxxxxx>
> 
> 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@xxxxxxxxxxxxx
> http://lists.xen.org/xen-devel

_______________________________________________
Xen-api mailing list
Xen-api@xxxxxxxxxxxxx
http://lists.xen.org/cgi-bin/mailman/listinfo/xen-api


 


Rackspace

Lists.xenproject.org is hosted with RackSpace, monitoring our
servers 24x7x365 and backed by RackSpace's Fanatical Support®.