|
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index] [Xen-API] [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".
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-api mailing list
Xen-api@xxxxxxxxxxxxx
http://lists.xen.org/cgi-bin/mailman/listinfo/xen-api
|
 |
Lists.xenproject.org is hosted with RackSpace, monitoring our |