";
- print_one_type variance ty;
- List.iter
- (fun (variance, t) ->
- Format.fprintf fmt "@,%s" sep;
- print_one_type variance t
- )
- tyl;
- Format.fprintf fmt "@]"
- end;
- Format.pp_print_flush fmt ();
- Buffer.contents buf
-
-
-let string_of_type_param_list t =
- Printf.sprintf "%s"
- (raw_string_of_type_list " "
- (List.map
- (fun (typ, co, cn) -> (Odoc_str.string_of_variance t (co, cn), typ))
- t.Odoc_type.ty_parameters
- )
- )
-
-let string_of_type_extension_param_list te =
- Printf.sprintf "%s"
- (raw_string_of_type_list " "
- (List.map
- (fun typ -> ("", typ))
- te.Odoc_extension.te_type_parameters
- )
- )
-
-let string_of_value v =
- let module M = Odoc_value in
- "let "^(Name.simple v.M.val_name)^" : "^
- (Odoc_print.string_of_type_expr v.M.val_type)^"\n"^
- (match v.M.val_info with
- None -> ""
- | Some i -> Odoc_misc.string_of_info i)
-
-(*module Generator =
-struct
-class html =
- object (self)
- inherit Html.html as html
-
- method html_of_type_expr_param_list b m_name t =
- let s = string_of_type_param_list t in
- let s2 = Odoc_html.newline_to_indented_br s in
- bs b "";
- bs b (self#create_fully_qualified_idents_links m_name s2);
- bs b ""
-
- method html_of_module_kind b father ?modu kind =
- match kind with
- Module_struct eles ->
- self#html_of_text b [Code "{"];
- (
- match modu with
- None ->
- bs b "";
- List.iter (self#html_of_module_element b father) eles;
- bs b "
"
- | Some m ->
- let (html_file, _) = Naming.html_files m.m_name in
- bp b " .. " html_file
- );
- self#html_of_text b [Code "}"]
- | _ -> html#html_of_module_kind b father ?modu kind
-
- method html_of_module_parameter b father p =
- let (s_functor,s_arrow) =
- if !Odoc_html.html_short_functors then
- "", ""
- else
- "", "=> "
- in
- self#html_of_text b
- [
- Code (s_functor^"(");
- Code p.mp_name ;
- Code " : ";
- ] ;
- self#html_of_module_type_kind b father p.mp_kind;
- self#html_of_text b [ Code (") "^s_arrow)]
-
- method html_of_module_type_kind b father ?modu ?mt kind =
- match kind with
- Module_type_struct eles ->
- self#html_of_text b [Code "{"];
- (
- match mt with
- None ->
- (
- match modu with
- None ->
- bs b "";
- List.iter (self#html_of_module_element b father) eles;
- bs b "
"
- | Some m ->
- let (html_file, _) = Naming.html_files m.m_name in
- bp b " .. " html_file
- )
- | Some mt ->
- let (html_file, _) = Naming.html_files mt.mt_name in
- bp b " .. " html_file
- );
- self#html_of_text b [Code "}"]
- | _ -> html#html_of_module_type_kind b father ?modu ?mt kind
-
- method html_of_value b v =
- Odoc_info.reset_type_names ();
- bs b "\n" ;
- bp b "" (Naming.value_target v);
- bs b (self#keyword "let");
- bs b " ";
- (
- match v.val_code with
- None -> bs b (self#escape (Name.simple v.val_name))
- | Some c ->
- let file = Naming.file_code_value_complete_target v in
- self#output_code v.val_name (Filename.concat !Global.target_dir file) c;
- bp b "%s" file (self#escape (Name.simple v.val_name))
- );
- bs b "";
- bs b " : ";
- self#html_of_type_expr b (Name.father v.val_name) v.val_type;
- bs b "
";
- self#html_of_info b v.val_info;
- (
- if !Odoc_html.with_parameter_list then
- self#html_of_parameter_list b (Name.father v.val_name) v.val_parameters
- else
- self#html_of_described_parameter_list b (Name.father v.val_name) v.val_parameters
- )
-
- method html_of_type_extension b m_name te =
- Odoc_info.reset_type_names ();
- bs b "";
- bs b ((self#keyword "type")^" ");
- let s = string_of_type_extension_param_list te in
- let s2 = Odoc_html.newline_to_indented_br s in
- bs b "";
- bs b (self#create_fully_qualified_idents_links m_name s2);
- bs b "";
- (match te.te_type_parameters with [] -> () | _ -> bs b " ");
- bs b (self#create_fully_qualified_idents_links m_name te.te_type_name);
- bs b " += ";
- if te.te_private = Asttypes.Private then bs b "private ";
- bs b "
";
- bs b "\n";
- let print_one x =
- let father = Name.father x.xt_name in
- let cname = Name.simple x.xt_name in
- bs b "\n\n";
- bs b "";
- bs b (self#keyword "|");
- bs b " | \n\n";
- bs b "";
- bp b "%s"
- (Naming.extension_target x)
- (Name.simple x.xt_name);
- (
- match x.xt_args, x.xt_ret with
- Cstr_tuple [], None -> ()
- | l, None ->
- bs b (" " ^ (self#keyword "of") ^ " ");
- self#html_of_cstr_args ~par: false b father cname " * " l;
- | Cstr_tuple [], Some r ->
- bs b (" " ^ (self#keyword ":") ^ " ");
- self#html_of_type_expr b father r;
- | l, Some r ->
- bs b (" " ^ (self#keyword ":") ^ " ");
- self#html_of_cstr_args ~par: false b father cname " * " l;
- bs b (" " ^ (self#keyword "->") ^ " ");
- self#html_of_type_expr b father r;
- );
- (
- match x.xt_alias with
- None -> ()
- | Some xa ->
- bs b " = ";
- (
- match xa.xa_xt with
- None -> bs b xa.xa_name
- | Some x ->
- bp b "%s" (Naming.complete_extension_target x) x.xt_name
- )
- );
- bs b " | \n";
- (
- match x.xt_text with
- None -> ()
- | Some t ->
- bs b "";
- bs b "";
- bs b "";
- );
- bs b "\n
"
- in
- Odoc_html.print_concat b "\n" print_one te.te_constructors;
- bs b "
\n";
- bs b "\n";
- self#html_of_info b te.te_info;
- bs b "\n"
-
- method html_of_exception b e =
- let cname = Name.simple e.ex_name in
- Odoc_info.reset_type_names ();
- bs b "\n";
- bp b "" (Naming.exception_target e);
- bs b (self#keyword "exception");
- bs b " ";
- bs b (Name.simple e.ex_name);
- bs b "";
- (
- match e.ex_args, e.ex_ret with
- Cstr_tuple [], None -> ()
- | _,None ->
- bs b (" "^(self#keyword "of")^" ");
- self#html_of_cstr_args
- ~par: false b (Name.father e.ex_name) cname " * " e.ex_args
- | Cstr_tuple [],Some r ->
- bs b (" " ^ (self#keyword ":") ^ " ");
- self#html_of_type_expr b (Name.father e.ex_name) r;
- | l,Some r ->
- bs b (" " ^ (self#keyword ":") ^ " ");
- self#html_of_cstr_args
- ~par: false b (Name.father e.ex_name) cname " * " l;
- bs b (" " ^ (self#keyword "->") ^ " ");
- self#html_of_type_expr b (Name.father e.ex_name) r;
- );
- (
- match e.ex_alias with
- None -> ()
- | Some ea ->
- bs b " = ";
- (
- match ea.ea_ex with
- None -> bs b ea.ea_name
- | Some e ->
- bp b "%s" (Naming.complete_exception_target e) e.ex_name
- )
- );
- bs b "\n";
- self#html_of_info b e.ex_info
-
- method html_of_type b t =
- Odoc_info.reset_type_names ();
- let father = Name.father t.ty_name in
- let print_field_prefix () =
- bs b "\n\n";
- bs b " ";
- bs b " | \n\n";
- bs b "";
- in
- let print_field_comment = function
- | None -> ()
- | Some t ->
- bs b "";
- bs b ""
- in
- bs b
- (match t.ty_manifest, t.ty_kind with
- None, Type_abstract
- | None, Type_open -> "\n"
- | None, Type_variant _
- | None, Type_record _ -> "\n"
- | Some _, Type_abstract
- | Some _, Type_open -> "\n"
- | Some _, Type_variant _
- | Some _, Type_record _ -> "\n"
- );
- bp b "" (Naming.type_target t);
- bs b ((self#keyword "type")^" ");
- bs b (Name.simple t.ty_name);
- (match t.ty_parameters with [] -> () | _ -> bs b " ");
- self#html_of_type_expr_param_list b father t;
- bs b " ";
- let priv = t.ty_private = Asttypes.Private in
- (
- match t.ty_manifest with
- None -> ()
- | Some (Object_type fields) ->
- bs b "= ";
- if priv then bs b "private ";
- bs b "< ";
- bs b " \n" ;
- let print_one f =
- print_field_prefix () ;
- bp b "%s : "
- (Naming.objfield_target t f)
- f.of_name;
- self#html_of_type_expr b father f.of_type;
- bs b ";\n";
- print_field_comment f.of_text ;
- bs b "\n"
- in
- Odoc_html.print_concat b "\n" print_one fields;
- bs b " \n>\n";
- bs b " "
- | Some (Other typ) ->
- bs b "= ";
- if priv then bs b "private ";
- self#html_of_type_expr b father typ;
- bs b " "
- );
- (match t.ty_kind with
- Type_abstract -> bs b "
"
- | Type_variant l ->
- bs b "= ";
- if priv then bs b "private ";
- bs b
- (
- match t.ty_manifest with
- None -> " "
- | Some _ -> ""
- );
- bs b "\n";
- let print_one constr =
- bs b "\n\n";
- bs b "";
- bs b (self#keyword "|");
- bs b " | \n\n";
- bs b "";
- bp b "%s"
- (Naming.const_target t constr)
- (self#constructor constr.vc_name);
- (
- match constr.vc_args, constr.vc_ret with
- Cstr_tuple [], None -> ()
- | l,None ->
- bs b (" " ^ (self#keyword "of") ^ " ");
- self#html_of_cstr_args ~par: false b father constr.vc_name " * " l;
- | Cstr_tuple [],Some r ->
- bs b (" " ^ (self#keyword ":") ^ " ");
- self#html_of_type_expr b father r;
- | l,Some r ->
- bs b (" " ^ (self#keyword ":") ^ " ");
- self#html_of_cstr_args ~par: false b father constr.vc_name " * " l;
- bs b (" " ^ (self#keyword "->") ^ " ");
- self#html_of_type_expr b father r;
- );
- bs b " | \n";
- (
- match constr.vc_text with
- None -> ()
- | Some t ->
- bs b "";
- bs b "";
- bs b "";
- );
- bs b "\n "
- in
- Odoc_html.print_concat b "\n" print_one l;
- bs b " \n"
- | Type_record l ->
- bs b "= ";
- if priv then bs b "private " ;
- bs b "{";
- bs b
- (
- match t.ty_manifest with
- None -> ""
- | Some _ -> ""
- );
- bs b "\n" ;
- let print_one r =
- bs b "\n\n";
- bs b " ";
- bs b " | \n\n";
- bs b "";
- if r.rf_mutable then bs b (self#keyword "mutable ") ;
- bp b "%s : "
- (Naming.recfield_target t r)
- r.rf_name;
- self#html_of_type_expr b father r.rf_type;
- bs b ", | \n";
- (
- match r.rf_text with
- None -> ()
- | Some t ->
- bs b "";
- bs b "";
- );
- bs b "\n "
- in
- Odoc_html.print_concat b "\n" print_one l;
- bs b " \n}\n"
- | Type_open ->
- bs b "= ..";
- bs b ""
- );
- bs b "\n";
- self#html_of_info b t.ty_info;
- bs b "\n"
-
- method html_of_class_kind b father ?cl kind =
- match kind with
- Class_structure (inh, eles) ->
- self#html_of_text b [Code "{"];
- (
- match cl with
- None ->
- bs b "\n";
- (
- match inh with
- [] -> ()
- | _ ->
- self#generate_inheritance_info b inh
- );
- List.iter (self#html_of_class_element b) eles;
- | Some cl ->
- let (html_file, _) = Naming.html_files cl.cl_name in
- bp b " .. " html_file
- );
- self#html_of_text b [Code "}"]
- | _ -> html#html_of_class_kind b father ?cl kind
-
-
- method html_of_class_type_kind b father ?ct kind =
- match kind with
- Class_signature (inh, eles) ->
- self#html_of_text b [Code "{"];
- (
- match ct with
- None ->
- bs b "\n";
- (
- match inh with
- [] -> ()
- | _ -> self#generate_inheritance_info b inh
- );
- List.iter (self#html_of_class_element b) eles
- | Some ct ->
- let (html_file, _) = Naming.html_files ct.clt_name in
- bp b " .. " html_file
- );
- self#html_of_text b [Code "}"]
- | _ -> html#html_of_class_type_kind b father ?ct kind
-
- end
-end
-
-let _ = Odoc_args.set_generator
- (Odoc_gen.Html (module Generator : Odoc_html.Html_generator))
- ;;*)
|