Affichage des variances des parametres de types semble ok

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@5823 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

13 files changed, 173 insertions, 82 deletions

diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index 9a7beb1f9..d45d62c2c 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -1008,9 +1008,14 @@ module Analyser =
                   {
                     ty_name = complete_name ;
                     ty_info = com_opt ;
-                    ty_parameters = List.map
-                      (Odoc_env.subst_type new_env) 
-                      tt_type_decl.Types.type_params ;
+                    ty_parameters = 
+		      List.map2
+		        (fun p (co,cn,_) ->
+			  (Odoc_env.subst_type new_env p,
+			   co, cn)
+			)
+		      tt_type_decl.Types.type_params
+		      tt_type_decl.Types.type_variance ;
                     ty_kind = kind ;
                     ty_manifest =
                     (match tt_type_decl.Types.type_manifest with
diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
index c3a622ad6..164b8b148 100644
--- a/ocamldoc/odoc_html.ml
+++ b/ocamldoc/odoc_html.ml
@@ -805,14 +805,15 @@ class html =
       in
       s2
 
-    (** Return html code to display a [Types.type_expr].*)
+    (** Return html code to display a [Types.type_expr]. *)
     method html_of_type_expr m_name t =
       let s = String.concat "\n"
           (Str.split (Str.regexp "\n") (Odoc_info.string_of_type_expr t))
       in
       let s2 = Str.global_replace (Str.regexp "\n") "<br>       " s in
-      "<code class=\"type\">"^(self#create_fully_qualified_idents_links m_name s2)^"</code>"
-
+      Printf.sprintf 
+	"<code class=\"type\">%s</code>"
+	(self#create_fully_qualified_idents_links m_name s2)
 
     (** Return html code to display a [Types.class_type].*)
     method html_of_class_type_expr m_name t =
@@ -831,6 +832,12 @@ class html =
       print_DEBUG "html#html_of_type_expr_list: 2";
       "<code class=\"type\">"^(self#create_fully_qualified_idents_links m_name s2)^"</code>"
 
+    (** Return html code to display a list of type parameters for the given type.*)
+    method html_of_type_expr_param_list m_name t =
+      let s = Odoc_info.string_of_type_param_list t in
+      let s2 = Str.global_replace (Str.regexp "\n") "<br>       " s in
+      "<code class=\"type\">"^(self#create_fully_qualified_idents_links m_name s2)^"</code>"
+
     (** Return html code to display a [Types.module_type]. *)
     method html_of_module_type m_name t =
       let s = String.concat "\n"
@@ -915,11 +922,8 @@ class html =
       (self#keyword "type")^" "^
       (* html mark *)
       "<a name=\""^(Naming.type_target t)^"\"></a>"^
-      (match t.ty_parameters with
-        [] -> ""
-      | tp :: [] -> (self#html_of_type_expr father tp)^" "
-      | l -> "("^(self#html_of_type_expr_list father ", " l)^") "
-      )^
+      (self#html_of_type_expr_param_list father t)^
+      (match t.ty_parameters with [] -> "" | _ -> " ")^
       (Name.simple t.ty_name)^" "^
       (match t.ty_manifest with None -> "" | Some typ -> "= "^(self#html_of_type_expr father typ)^" ")^
       (match t.ty_kind with
diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml
index d6b7fdbe7..7438fd613 100644
--- a/ocamldoc/odoc_info.ml
+++ b/ocamldoc/odoc_info.ml
@@ -110,11 +110,13 @@ let load_modules = Odoc_analyse.load_modules
 
 let reset_type_names = Printtyp.reset
 
+let string_of_variance t (co,cn) = Odoc_str.string_of_variance t (co, cn)
+
 let string_of_type_expr t = Odoc_misc.string_of_type_expr t
 
-(** This function returns a string to represent the given list of types,
-   with a given separator. *)
-let string_of_type_list sep type_list = Odoc_misc.string_of_type_list sep type_list
+let string_of_type_list sep type_list = Odoc_str.string_of_type_list sep type_list
+
+let string_of_type_param_list t = Odoc_str.string_of_type_param_list t
 
 let string_of_module_type = Odoc_misc.string_of_module_type
 
diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli
index ea1aa10f5..eaf102804 100644
--- a/ocamldoc/odoc_info.mli
+++ b/ocamldoc/odoc_info.mli
@@ -214,7 +214,8 @@ module Type :
         {
           ty_name : Name.t ; (** Complete name of the type. *)
           mutable ty_info : info option ; (** Information found in the optional associated comment. *)
-          ty_parameters : Types.type_expr list ; (** Type parameters. *)
+          ty_parameters : (Types.type_expr * bool * bool) list ; 
+                    (** type parameters: (type, covariant, contravariant) *)
           ty_kind : type_kind ; (** Type kind. *)
           ty_manifest : Types.type_expr option; (** Type manifest. *)
           mutable ty_loc : location ;
@@ -596,6 +597,13 @@ val load_modules : string -> Odoc_module.t_module list
    classes (call it) and methods and attributes (don't call it).*)
 val reset_type_names : unit -> unit
 
+(** [string_of_variance t (covariant, invariant)] returns ["+"] if
+   the given information means "covariant", ["-"] if the it means
+   "contravariant", orelse [""], and always [""] if the given
+   type is not an abstract type with no manifest (i.e. no need
+   for the variance to be printed.*)
+val string_of_variance : Type.t_type -> (bool * bool) -> string
+
 (** This function returns a string representing a Types.type_expr. 
    It writes in and flushes [Format.str_formatter]. *)
 val string_of_type_expr : Types.type_expr -> string
@@ -604,6 +612,10 @@ val string_of_type_expr : Types.type_expr -> string
    with a given separator. It writes in and flushes [Format.str_formatter].*)
 val string_of_type_list : string -> Types.type_expr list -> string
 
+(** This function returns a string to represent the list of type parameters
+   for the given type. It writes in and flushes [Format.str_formatter].*)
+val string_of_type_param_list : Type.t_type -> string
+
 (** This function returns a string representing a [Types.module_type]. 
    @param complete indicates if we must print complete signatures
    or just [sig end]. Default if [false].
diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml
index c6f59f9bc..13f38b76a 100644
--- a/ocamldoc/odoc_latex.ml
+++ b/ocamldoc/odoc_latex.ml
@@ -374,6 +374,20 @@ class latex =
         ((Latex (self#make_label (self#method_label m.met_value.val_name))) :: 
          (to_text#text_of_method m))
 
+    (** Return LaTeX code for the parameters of a type. *)
+    method latex_of_type_params m_name t =
+      let f (p, co, cn) =
+	Printf.sprintf "%s%s"
+	  (Odoc_info.string_of_variance t (co,cn))
+	  (self#normal_type m_name p)
+      in
+      match t.ty_parameters with
+        [] -> ""
+      | [(p,co,cn)] -> f (p, co, cn)
+      | l -> 
+	  Printf.sprintf "(%s)"
+	    (String.concat ", " (List.map f t.ty_parameters))
+
     (** Return LaTeX code for a type. *)
     method latex_of_type t =
       let s_name = Name.simple t.ty_name in
@@ -381,15 +395,11 @@ class latex =
         Odoc_info.reset_type_names () ;
         let mod_name = Name.father t.ty_name in
         let s_type1 = 
-          Format.fprintf Format.str_formatter 
-            "@[<hov 2>type ";
-          match t.ty_parameters with
-            [] -> Format.flush_str_formatter ()
-          | [p] -> self#normal_type mod_name p
-          | l -> 
-              Format.fprintf Format.str_formatter "(" ;
-              let s = self#normal_type_list mod_name ", " l in
-              s^")"
+          Format.fprintf Format.str_formatter "@[<hov 2>type ";
+          Format.fprintf Format.str_formatter "%s%s" 
+	    (self#latex_of_type_params mod_name t)
+	    (match t.ty_parameters with [] -> "" | _ -> " ");
+	  Format.flush_str_formatter ()
         in
         Format.fprintf Format.str_formatter 
           ("@[<hov 2>%s %s")
diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml
index 7062be62c..c4108e55b 100644
--- a/ocamldoc/odoc_man.ml
+++ b/ocamldoc/odoc_man.ml
@@ -257,10 +257,19 @@ class man =
 
     (** Groff string to display a [Types.type_expr list].*)
     method man_of_type_expr_list m_name sep l =
-      let s = Odoc_misc.string_of_type_list sep l in
+      let s = Odoc_str.string_of_type_list sep l in
       let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
       "\n.B "^(self#relative_idents m_name s2)^"\n"
 
+    (** Groff string to display the parameters of a type.*)
+    method man_of_type_expr_param_list m_name t =
+      match t.ty_parameters with
+        [] -> ""
+      | l ->
+	  let s = Odoc_str.string_of_type_param_list t in
+	  let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
+	  "\n.B "^(self#relative_idents m_name s2)^"\n"
+
     (** Groff string to display a [Types.module_type]. *)
     method man_of_module_type m_name t =
       let s = String.concat "\n"
@@ -306,12 +315,7 @@ class man =
       Odoc_info.reset_type_names () ;
       let father = Name.father t.ty_name in
       ".I type "^
-      (match t.ty_parameters with
-        [] -> ""
-      | tp :: [] -> (Odoc_misc.string_of_type_expr tp)
-      | l ->
-          (self#man_of_type_expr_list father ", " l)
-      )^
+      (self#man_of_type_expr_param_list father t)^
       (match t.ty_parameters with [] -> "" | _ -> ".I ")^(Name.simple t.ty_name)^" \n"^
       (match t.ty_manifest with None -> "" | Some typ -> "= "^(self#man_of_type_expr father typ))^
       (
@@ -455,7 +459,7 @@ class man =
       (
        match c.cl_type_parameters with
          [] -> ()
-       | l -> p buf "[%s.I] " (Odoc_misc.string_of_type_list ", " l)
+       | l -> p buf "[%s.I] " (Odoc_str.string_of_type_list ", " l)
       );
       p buf "%s : %s" 
         (Name.simple c.cl_name)
@@ -473,7 +477,7 @@ class man =
       (
        match ct.clt_type_parameters with
         [] -> ()
-      | l -> p buf "[%s.I ] " (Odoc_misc.string_of_type_list ", " l)
+      | l -> p buf "[%s.I ] " (Odoc_str.string_of_type_list ", " l)
       );
       p buf "%s = %s" 
         (Name.simple ct.clt_name)
diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml
index e7cce8717..d2c3c52e3 100644
--- a/ocamldoc/odoc_misc.ml
+++ b/ocamldoc/odoc_misc.ml
@@ -36,44 +36,12 @@ let input_file_as_string nom =
 let string_of_longident li = String.concat "." (Longident.flatten li)
 
 let string_of_type_expr t =
+  let b = Buffer.create 256 in
+  let fmt = Format.formatter_of_buffer b in
   Printtyp.mark_loops t;
-  Printtyp.type_scheme_max ~b_reset_names: false Format.str_formatter t;
-  let s = Format.flush_str_formatter () in
-  s
-
-let string_of_type_list sep type_list =
-  let rec need_parent t =
-    match t.Types.desc with
-      Types.Tarrow _ | Types.Ttuple _ -> true
-    | Types.Tlink t2 | Types.Tsubst t2 -> need_parent t2
-    | Types.Tconstr _ ->
-        false
-    | Types.Tvar | Types.Tunivar | Types.Tobject _ | Types.Tpoly _
-    | Types.Tfield _ | Types.Tnil | Types.Tvariant _ -> false
-  in
-  let print_one_type t =
-    Printtyp.mark_loops t;
-    if need_parent t then
-      ( 
-       Format.fprintf Format.str_formatter "(" ;
-       Printtyp.type_scheme_max ~b_reset_names: false Format.str_formatter t;
-       Format.fprintf Format.str_formatter ")"
-      )
-    else
-      Printtyp.type_scheme_max ~b_reset_names: false Format.str_formatter t
-  in
-  begin match type_list with
-    [] -> ()
-  | [ty] -> print_one_type ty
-  | ty :: tyl ->
-      Format.fprintf Format.str_formatter "@[<hov 2>";
-      print_one_type ty;
-      List.iter
-        (fun t -> Format.fprintf Format.str_formatter "@,%s" sep; print_one_type t)
-        tyl;
-      Format.fprintf Format.str_formatter "@]"
-  end;
-  Format.flush_str_formatter()
+  Printtyp.type_scheme_max ~b_reset_names: false fmt t;
+  Format.pp_print_flush fmt () ;
+  Buffer.contents b
 
 (** Return the given module type where methods and vals have been removed
    from the signatures. Used when we don't want to print a too long module type.*)
diff --git a/ocamldoc/odoc_misc.mli b/ocamldoc/odoc_misc.mli
index 5f259adb9..caa1b0a27 100644
--- a/ocamldoc/odoc_misc.mli
+++ b/ocamldoc/odoc_misc.mli
@@ -22,10 +22,6 @@ val string_of_longident : Longident.t -> string
    It writes in and flushes [Format.str_formatter].*)
 val string_of_type_expr : Types.type_expr -> string
 
-(** This function returns a string to represent the given list of types,
-   with a given separator. It writes in and flushes [Format.str_formatter].*)
-val string_of_type_list : string -> Types.type_expr list -> string
-
 (** This function returns a string representing a [Types.module_type]. 
    @param complete indicates if we must print complete signatures
    or just [sig end]. Default if [false].
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index b97227220..ede23effa 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -625,7 +625,13 @@ module Analyser =
                     {
                       ty_name = Name.concat current_module_name name ;
                       ty_info = assoc_com ;
-                      ty_parameters = List.map (Odoc_env.subst_type new_env) sig_type_decl.Types.type_params ;
+                      ty_parameters = 
+		        List.map2 (fun p (co,cn,_) ->
+			             (Odoc_env.subst_type new_env p,
+				      co, cn)
+				  ) 
+			sig_type_decl.Types.type_params 
+			sig_type_decl.Types.type_variance;
                       ty_kind = type_kind ;
                       ty_manifest = 
                       (match sig_type_decl.Types.type_manifest with
diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml
index 74ac8453d..7411b551e 100644
--- a/ocamldoc/odoc_str.ml
+++ b/ocamldoc/odoc_str.ml
@@ -14,12 +14,76 @@
 
 module Name = Odoc_name
 
+let string_of_variance t (co,cn) =
+  if t.Odoc_type.ty_kind = Odoc_type.Type_abstract &&
+    t.Odoc_type.ty_manifest = None
+  then
+    match (co, cn) with
+      (true, false) -> "+"
+    | (false, true) -> "-"
+    | _ -> ""
+  else
+    ""
+
+let raw_string_of_type_list sep type_list =
+  let rec need_parent t =
+    match t.Types.desc with
+      Types.Tarrow _ | Types.Ttuple _ -> true
+    | Types.Tlink t2 | Types.Tsubst t2 -> need_parent t2
+    | Types.Tconstr _ ->
+        false
+    | Types.Tvar | Types.Tunivar | Types.Tobject _ | Types.Tpoly _
+    | Types.Tfield _ | Types.Tnil | Types.Tvariant _ -> false
+  in
+  let print_one_type variance t =
+    Printtyp.mark_loops t;
+    if need_parent t then
+      ( 
+       Format.fprintf Format.str_formatter "(%s" variance;
+       Printtyp.type_scheme_max ~b_reset_names: false Format.str_formatter t;
+       Format.fprintf Format.str_formatter ")"
+      )
+    else
+      (
+       Format.fprintf Format.str_formatter "%s" variance;
+       Printtyp.type_scheme_max ~b_reset_names: false Format.str_formatter t
+      )
+  in
+  begin match type_list with
+    [] -> ()
+  | [(variance, ty)] -> print_one_type variance ty
+  | (variance, ty) :: tyl ->
+      Format.fprintf Format.str_formatter "@[<hov 2>(";
+      print_one_type variance ty;
+      List.iter
+        (fun (variance, t) -> 
+	  Format.fprintf Format.str_formatter "@,%s" sep; 
+	  print_one_type variance t
+	)
+        tyl;
+      Format.fprintf Format.str_formatter ")@]"
+  end;
+  Format.flush_str_formatter()
+
+let string_of_type_list sep type_list =
+  raw_string_of_type_list sep (List.map (fun t -> ("", t)) type_list)
+
+let string_of_type_param_list t =
+  raw_string_of_type_list ", "
+    (List.map 
+       (fun (typ, co, cn) -> (string_of_variance t (co, cn), typ))
+       t.Odoc_type.ty_parameters
+    )
+
 let string_of_type t =
   let module M = Odoc_type in
   "type "^
   (String.concat ""
      (List.map 
-        (fun p -> (Odoc_misc.string_of_type_expr p)^" ")
+        (fun (p, co, cn) -> 
+	  (string_of_variance t (co, cn))^
+	  (Odoc_misc.string_of_type_expr p)^" "
+	)
         t.M.ty_parameters
      )
   )^
diff --git a/ocamldoc/odoc_str.mli b/ocamldoc/odoc_str.mli
index 711de7e6a..12116f5a7 100644
--- a/ocamldoc/odoc_str.mli
+++ b/ocamldoc/odoc_str.mli
@@ -12,6 +12,17 @@
 
 (** The functions to get a string from different kinds of elements (types, modules, ...). *)
 
+(** @return the variance string for the given type and (covariant, contravariant) information. *)
+val string_of_variance : Odoc_type.t_type -> (bool * bool) -> string
+
+(** This function returns a string to represent the given list of types,
+   with a given separator. It writes in and flushes [Format.str_formatter].*)
+val string_of_type_list : string -> Types.type_expr list -> string
+
+(** This function returns a string to represent the list of type parameters
+   for the given type. It writes in and flushes [Format.str_formatter].*)
+val string_of_type_param_list : Odoc_type.t_type -> string
+
 (** @return a string to describe the given type. *)
 val string_of_type : Odoc_type.t_type -> string
 
diff --git a/ocamldoc/odoc_texi.ml b/ocamldoc/odoc_texi.ml
index 9a309aa29..55e588a29 100644
--- a/ocamldoc/odoc_texi.ml
+++ b/ocamldoc/odoc_texi.ml
@@ -591,11 +591,19 @@ class texi =
       self#texi_of_text t
 
 
-    method string_of_type_parameter = function
+    method string_of_type_parameters t = 
+      let f (tp, co, cn) =
+	Printf.sprintf "%s%s"
+	  (Odoc_info.string_of_variance t (co, cn))
+	  (Odoc_info.string_of_type_expr tp)
+      in
+      match t.ty_parameters with
       | [] -> ""
-      | [ tp ] -> (Odoc_info.string_of_type_expr tp) ^ " "
-      | l -> "(" ^ (String.concat ", "
-                      (List.map Odoc_info.string_of_type_expr l)) ^ ") "
+      | [ (tp, co, cn) ] -> 
+	  (f (tp, co, cn))^" "
+      | l -> 
+	  Printf.sprintf "(%s) "
+	    (String.concat ", " (List.map f l))
 
     method string_of_type_args = function
       | [] -> ""
@@ -607,7 +615,7 @@ class texi =
       let t = 
         [ self#fixedblock ( 
           [ Newline ; minus ; Raw "type " ;
-            Raw (self#string_of_type_parameter ty.ty_parameters) ;
+            Raw (self#string_of_type_parameters ty) ;
             Raw (Name.simple ty.ty_name) ] @
           ( match ty.ty_manifest with
           | None -> [] 
diff --git a/ocamldoc/odoc_type.ml b/ocamldoc/odoc_type.ml
index 4e53fac15..946b70eb0 100644
--- a/ocamldoc/odoc_type.ml
+++ b/ocamldoc/odoc_type.ml
@@ -41,7 +41,8 @@ type type_kind =
 type t_type = {
     ty_name : Name.t ;
     mutable ty_info : Odoc_types.info option ; (** optional user information *)
-    ty_parameters : Types.type_expr list ; (** type parameters *)
+    ty_parameters : (Types.type_expr * bool * bool) list ; 
+                    (** type parameters: (type, covariant, contravariant) *)
     ty_kind : type_kind ;
     ty_manifest : Types.type_expr option; (** type manifest *)
     mutable ty_loc : Odoc_types.location ;