let rec make_type tbuf fbuf childmap name is_abstract t =
  let is_virtual name =
    let children = List.assoc name childmap in
    children <> []
  in

  let make_enumeration values =
    let name' = escape_typename name in
    let name' = if is_virtual name then name' ^ "_final" else name' in
    let values = List.map to_string values in

    (* The type. *)
    bprintf tbuf "and %s = [\n" name';
    List.iter (
      fun value -> bprintf tbuf "\t| `%s\n" (escape_backquote value)
    ) values;
    bprintf tbuf "]\n";

    (* node_of_type and type_of_node functions. *)
    bprintf fbuf "and node_of_%s ?a ctx name = function\n" name';
    List.iter (
      fun value ->
        bprintf fbuf "\t| `%s -> node_of_string ?a ctx name \"%s\"\n"
          (escape_backquote value) (escape_str value)
    ) values;
    bprintf fbuf "and %s_of_node np node =\n" name';
    bprintf fbuf "  %s_of_string node#data;\n" name';

    (* string_of_type and type_of_string functions. *)
    bprintf fbuf "and string_of_%s = function\n" name';
    List.iter (
      fun value -> bprintf fbuf "\t| `%s -> \"%s\"\n"
        (escape_backquote value) (escape_str value)
    ) values;
    bprintf fbuf "and %s_of_string = function\n" name';
    List.iter (
      fun value -> bprintf fbuf "\t| \"%s\" -> `%s\n"
        (escape_str value) (escape_backquote value)
    ) values;
    bprintf fbuf "\t| _ -> invalid_arg \"%s_of_string\"\n" name'
  in

  let make_sequence elements =
    let name' = escape_typename name in
    let name' = if is_virtual name then name' ^ "_final" else name' in
    let elements = List.map (
      fun (elname, eltype, nillable, min_occurs, max_occurs) ->
        let elname = to_string elname in
        let eltype = to_string eltype in
        let octype, is_option, is_list =
          map_xsdtype_to_ocaml eltype nillable min_occurs max_occurs in
        (elname, eltype, octype,
         nillable, min_occurs, max_occurs, is_option, is_list)
    ) elements in

    (* Generate the record type. *)
    bprintf tbuf "and %s = {\n" name';
    List.iter (
      fun (elname, eltype, octype,
           nillable, min_occurs, max_occurs, is_option, is_list) ->
        bprintf tbuf "\t%s_%s : %s" name' (escape_fieldname elname) octype;
        if is_option then bprintf tbuf " option"
        else if is_list then (
          bprintf tbuf " list (* ";
          if nillable && min_occurs > 0 then bprintf tbuf "empty, ";
          bprintf tbuf "%d - " min_occurs;
          if max_occurs = -1 then bprintf tbuf "unbounded "
          else bprintf tbuf "%d " max_occurs;
          bprintf tbuf "*)";
        );
        bprintf tbuf ";\n";
    ) elements;
    bprintf tbuf "}\n";

    (* Function to serialise the record. *)
    bprintf fbuf "and node_of_%s ?a ctx name v =\n" name';
    bprintf fbuf "  element ?a ctx name (List.concat [\n";
    List.iter (
      fun (elname, eltype, octype,
           nillable, min_occurs, max_occurs, is_option, is_list) ->
        let fn = fn_type_to_node eltype in
        if is_option then
          bprintf fbuf ("    (match v.%s_%s with None -> []" ^^
                        " | Some v -> [%s ctx \"fn:%s\" v]);\n")
            name' (escape_fieldname elname) fn elname
        else if is_list then
          bprintf fbuf "    List.map (%s ctx \"fn:%s\") v.%s_%s;\n"
            fn elname name' (escape_fieldname elname)
        else
          bprintf fbuf "    [%s ctx \"fn:%s\" v.%s_%s];\n"
            fn elname name' (escape_fieldname elname)
    ) elements;
    bprintf fbuf "  ])\n";

    (* Function to deserialise the record. *)
    bprintf fbuf "and %s_of_node np node =\n" name';
    bprintf fbuf "  {\n";
    List.iter (
      fun (elname, eltype, octype,
           nillable, min_occurs, max_occurs, is_option, is_list) ->
        bprintf fbuf "    %s_%s = (" name' (escape_fieldname elname);
        let fn = fn_node_to_type eltype in
        if is_option then
          bprintf fbuf
            ("try " ^^
             "let node = Pxp_document.find_element (np ^ \":%s\") node in " ^^
             (* XXX what is the prefix? Not always xsi:... *)
             "(match node#optional_string_attribute \"xsi:nil\" with " ^^
             "| Some \"true\" -> None " ^^
             "| _ -> Some (%s np node)) " ^^
             "with Not_found -> None")
            elname fn
        else if is_list then
          bprintf fbuf
            ("let nodes = Pxp_document.find_all_elements " ^^
               "(np ^ \":%s\") node in " ^^
             "List.map (%s np) nodes")
            elname fn
        else
          bprintf fbuf
            ("let node = try " ^^
             "Pxp_document.find_element (np ^ \":%s\") node " ^^
             "with Not_found -> " ^^
             "invalid_arg \"%s_of_node: missing element: %s\" in " ^^
             "%s np node")
            elname name' elname fn;
        bprintf fbuf ");\n";
    ) elements;
    bprintf fbuf "  }\n";
  in

  (* A top-level element defines a type, plus functions to pack and
   * unpack the element itself.
   *)
  let make_element t =
    make_type tbuf fbuf childmap name is_abstract t
  in

  let make_typedef othertype =
    let name' = escape_typename name in
    bprintf tbuf "and %s = %s\n" name' (convert_type (to_string othertype))
  in

  let make_unit () =
    let name' = escape_typename name in
    bprintf tbuf "and %s = unit\n" name;
    bprintf fbuf "and node_of_%s ?a ctx name () =\n" name';
    bprintf fbuf "  element ?a ctx name []\n";
    bprintf fbuf "and %s_of_node _ _ = ()\n" name';
  in

  match t with
    | Enumeration values ->
        make_enumeration values
    | Sequence elements ->
        make_sequence elements
    | Element t ->
        make_element t
    | Typedef othertype ->
        make_typedef othertype
    | Unit ->
        make_unit ()
    | Extension _ ->
        assert false (* Should never happen - extensions should have been
                      * removed by make_extensions function above.
                      *)

and make_types tbuf fbuf childmap types =
  List.iter (
    fun (name, is_abstract, t) ->
      make_type tbuf fbuf childmap name is_abstract t
  ) types