let make_virtual_types tbuf fbuf childmap types =
  List.iter (
    fun (name, _, _) ->
      (* Name of the children of this type. *)
      let children = List.assoc name childmap in
      (* If there are any children, it's a virtual type, so build
       * the virtual type.
       *)
      if children <> [] then (
        let name' = escape_typename name in

        bprintf tbuf "and %s = [\n" name';
        List.iter (
          fun child ->
            bprintf tbuf "\t| `%s of %s\n" child (escape_typename child)
        ) children;
        bprintf tbuf "]\n";

        (* Build node_of_type and type_of_node functions. *)
        bprintf fbuf "and node_of_%s ?a ctx name = function\n" name';
        List.iter (
          fun child ->
            bprintf fbuf "\t| `%s v -> node_of_%s ~a:((\"xsi:type\", \"fn:%s\") :: match a with None -> [] | Some a -> a) ctx name v\n"
              child (escape_typename child) child
        ) children;

        bprintf fbuf
          ("and %s_of_node np node =\n" ^^
           (* XXX what is the prefix? Not always xsi:... *)
           "  match node#optional_string_attribute \"xsi:type\" with\n" ^^
           "  | None -> failwith \"%s_of_node: missing xsi:type\"\n" ^^
           "  | Some xsi_type ->\n" ^^
           (* XXX Ignore the namespace. *)
           "    let xsi_type =\n" ^^
           "      try let i = String.rindex xsi_type ':' in\n" ^^
           "        let n = String.length xsi_type in\n" ^^
           "        String.sub xsi_type (i+1) (n-i-1)\n" ^^
           "      with Not_found -> xsi_type in\n" ^^
           "    match xsi_type with\n")
          name' name';

        List.iter (
          fun child ->
            bprintf fbuf "\t| \"%s\" -> `%s (%s_of_node np node)\n"
              child child (escape_typename child)
        ) children;

        bprintf fbuf "\t| _ -> failwith (\"%s_of_node: unknown xsi:type: \" ^ xsi_type)\n" name'
      )
  ) types