libxl: ocaml: provide defaults for libxl types

Libxl functions such as libxl_domain_create_new take large structs
of configuration parameters. Often, we would like to use the default
values for many of these parameters.

The struct and keyed-union types in libxl have init functions, which
fill in the defaults for a given type. This commit provides an OCaml
interface to obtain records of defaults by calling the relevant init
function.

These default records can be used as a base to construct your own
records, and to selectively override parameters where needed.

For example, a Domain_create_info record can now be created as follows:

  Xenlight.Domain_create_info.({ default ctx () with
    ty = Xenlight.DOMAIN_TYPE_PV;
    name = Some vm_name;
    uuid = vm_uuid;
  })

For types with KeyedUnion fields, such as Domain_build_info, a record
with defaults is obtained by specifying the type key:

  Xenlight.Domain_build_info.default ctx ~ty:Xenlight.DOMAIN_TYPE_HVM ()

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>

diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index edadd144df78bf203cbcf2c95e52ac4399970ec9..0bb636ae61b929f89b587cc97c9e6da729f780ab 100644 (file)
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -119,6 +119,7 @@ def gen_struct(ty):
 
 def gen_ocaml_keyedunions(ty, interface, indent, parent = None):
     s = ""
+    union_type = ""
     
     if ty.rawname is not None:
         # Non-anonymous types need no special handling
@@ -158,9 +159,11 @@ def gen_ocaml_keyedunions(ty, interface, indent, parent = None):
         s += " | ".join(u) + "\n"
         ty.union_name = name
 
+        union_type = "?%s:%s" % (munge_name(nparent), ty.keyvar.type.rawname)
+
     if s == "":
-        return None
-    return s.replace("\n", "\n%s" % indent)
+        return None, None
+    return s.replace("\n", "\n%s" % indent), union_type
 
 def gen_ocaml_ml(ty, interface, indent=""):
 
@@ -196,17 +199,27 @@ def gen_ocaml_ml(ty, interface, indent=""):
                 s += "module %s = struct\n" % module_name
                 
         # Handle KeyedUnions...
+        union_types = []
         for f in ty.fields:
-            ku = gen_ocaml_keyedunions(f.type, interface, "\t")
+            ku, union_type = gen_ocaml_keyedunions(f.type, interface, "\t")
             if ku is not None:
                 s += ku
                 s += "\n"
+            if union_type is not None:
+                union_types.append(union_type)
 
         s += "\ttype t =\n"
         s += "\t{\n"
         s += gen_struct(ty)
         s += "\t}\n"
-        
+
+        if ty.init_fn is not None:
+            union_args = "".join([u + " -> " for u in union_types])
+            if interface:
+                s += "\tval default : ctx -> %sunit -> t\n" % union_args
+            else:
+                s += "\texternal default : ctx -> %sunit -> t = \"stub_libxl_%s_init\"\n" % (union_args, ty.rawname)
+
         if functions.has_key(ty.rawname):
             for name,args in functions[ty.rawname]:
                 s += "\texternal %s : " % name
@@ -434,6 +447,38 @@ def gen_c_stub_prototype(ty, fns):
         s += ");\n"
     return s
 
+def gen_c_default(ty):
+    s = "/* Get the defaults for %s */\n" % ty.rawname
+    # Handle KeyedUnions...
+    union_types = []
+    for f in ty.fields:
+        if isinstance(f.type, idl.KeyedUnion):
+            union_types.append(f.type.keyvar)
+
+    s += "value stub_libxl_%s_init(value ctx, %svalue unit)\n" % (ty.rawname,
+        "".join(["value " + u.name + ", " for u in union_types]))
+    s += "{\n"
+    s += "\tCAMLparam%d(ctx, %sunit);\n" % (len(union_types) + 2, "".join([u.name + ", " for u in union_types]))
+    s += "\tCAMLlocal1(val);\n"
+    s += "\tlibxl_%s c_val;\n" % ty.rawname
+    s += "\tlibxl_%s_init(&c_val);\n" % ty.rawname
+    for u in union_types:
+        s += "\tif (%s != Val_none) {\n" % u.name
+        s += "\t\t%s c = 0;\n" % u.type.typename
+        s += "\t\t%s_val(CTX, &c, Some_val(%s));\n" % (u.type.rawname, u.name)
+        s += "\t\tlibxl_%s_init_%s(&c_val, c);\n" % (ty.rawname, u.name)
+        s += "\t}\n"
+    s += "\tval = Val_%s(&c_val);\n" % ty.rawname
+    if ty.dispose_fn:
+        s += "\tlibxl_%s_dispose(&c_val);\n" % ty.rawname
+    s += "\tCAMLreturn(val);\n"
+    s += "}\n"
+    return s
+
+def gen_c_defaults(ty):
+    s = gen_c_default(ty)
+    return s
+
 def autogen_header(open_comment, close_comment):
     s = open_comment + " AUTO-GENERATED FILE DO NOT EDIT " + close_comment + "\n"
     s += open_comment + " autogenerated by \n"
@@ -486,12 +531,14 @@ if __name__ == '__main__':
         if ty.marshal_in():
             cinc.write(gen_c_val(ty))
             cinc.write("\n")
-        if ty.marshal_out():
-            cinc.write(gen_Val_ocaml(ty))
-            cinc.write("\n")
+        cinc.write(gen_Val_ocaml(ty))
+        cinc.write("\n")
         if functions.has_key(ty.rawname):
             cinc.write(gen_c_stub_prototype(ty, functions[ty.rawname]))
             cinc.write("\n")
+        if ty.init_fn is not None:
+            cinc.write(gen_c_defaults(ty))
+            cinc.write("\n")
         #sys.stdout.write("\n")
     
     ml.write("(* END OF AUTO-GENERATED CODE *)\n")