ocamldoc: handle Pmod_unpack and Tmod_unpack

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

8 files changed, 76 insertions, 3 deletions

diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml
index 5ab371488d..143da019d3 100644
--- a/ocamldoc/odoc_analyse.ml
+++ b/ocamldoc/odoc_analyse.ml
@@ -428,6 +428,7 @@ and remove_module_elements_between_stop_in_module_kind k =
       Odoc_module.Module_constraint (remove_module_elements_between_stop_in_module_kind k2,
                          remove_module_elements_between_stop_in_module_type_kind mtkind)
   | Odoc_module.Module_typeof _ -> k
+  | Odoc_module.Module_unpack _ -> k
 
 (** Remove the module elements between the stop special comment, in the given module type kind. *)
 and remove_module_elements_between_stop_in_module_type_kind tk =
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index 4922d059a4..3456e14dea 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -1647,6 +1647,24 @@ module Analyser =
             m_kind = Module_struct elements2 ;
           }
 
+      | (Parsetree.Pmod_unpack (p_exp, pkg_type),
+         Typedtree.Tmod_unpack (t_exp, tt_modtype)) ->
+          print_DEBUG ("Odoc_ast: case Parsetree.Pmod_unpack + Typedtree.Tmod_unpack "^module_name);
+          let code =
+            let loc = p_module_expr.Parsetree.pmod_loc in
+            let loc_end = loc.Location.loc_end.Lexing.pos_cnum in
+            let exp_loc = p_exp.Parsetree.pexp_loc in
+            let exp_loc_end = exp_loc.Location.loc_end.Lexing.pos_cnum in
+            let s = get_string_of_file exp_loc_end loc_end in
+            Printf.sprintf "(val ...%s" s
+          in
+          let name = Odoc_env.full_module_type_name env (Name.from_longident (fst pkg_type)) in
+          let alias = { mta_name = name ; mta_module = None } in
+          { m_base with
+            m_type = Odoc_env.subst_module_type env tt_modtype ;
+            m_kind = Module_unpack (code, alias) ;
+          }
+
       | (parsetree, typedtree) ->
           (*DEBUG*)let s_parse =
           (*DEBUG*)  match parsetree with
@@ -1655,6 +1673,7 @@ module Analyser =
           (*DEBUG*)  | Parsetree.Pmod_functor _ -> "Pmod_functor"
           (*DEBUG*)  | Parsetree.Pmod_apply _ -> "Pmod_apply"
           (*DEBUG*)  | Parsetree.Pmod_constraint _ -> "Pmod_constraint"
+          (*DEBUG*)  | Parsetree.Pmod_unpack _ -> "Pmod_unpack"
           (*DEBUG*)in
           (*DEBUG*)let s_typed =
           (*DEBUG*)  match typedtree with
@@ -1663,6 +1682,7 @@ module Analyser =
           (*DEBUG*)  | Typedtree.Tmod_functor _ -> "Tmod_functor"
           (*DEBUG*)  | Typedtree.Tmod_apply _ -> "Tmod_apply"
           (*DEBUG*)  | Typedtree.Tmod_constraint _ -> "Tmod_constraint"
+          (*DEBUG*)  | Typedtree.Tmod_unpack _ -> "Tmod_unpack"
           (*DEBUG*)in
           (*DEBUG*)let code = get_string_of_file pos_start pos_end in
           print_DEBUG (Printf.sprintf "code=%s\ns_parse=%s\ns_typed=%s\n" code s_parse s_typed);
diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml
index ab59a17278..4d9f3ca291 100644
--- a/ocamldoc/odoc_cross.ml
+++ b/ocamldoc/odoc_cross.ml
@@ -346,6 +346,31 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_
 
      | Module_typeof _ ->
         (acc_b, acc_inc, acc_names)
+
+     | Module_unpack (code, mta) ->
+        begin
+          match mta.mta_module with
+            Some _ ->
+              (acc_b, acc_inc, acc_names)
+          | None ->
+              let mt_opt =
+                try Some (lookup_module_type mta.mta_name)
+                with Not_found -> None
+              in
+              match mt_opt with
+                None -> (acc_b, (Name.head m.m_name) :: acc_inc,
+                   (* we don't want to output warning messages for
+                      "sig ... end" or "struct ... end" modules not found *)
+                   (if mta.mta_name = Odoc_messages.struct_end or
+                      mta.mta_name = Odoc_messages.sig_end then
+                      acc_names
+                    else
+                      (NF_mt mta.mta_name) :: acc_names)
+                  )
+              | Some mt ->
+                  mta.mta_module <- Some mt ;
+                  (true, acc_inc, acc_names)
+        end
   in
   iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) m.m_kind
 
@@ -803,6 +828,7 @@ and assoc_comments_module_kind parent_name module_list mk =
         (assoc_comments_module_kind parent_name module_list mk1,
          assoc_comments_module_type_kind parent_name module_list mtk)
   | Module_typeof _ -> mk
+  | Module_unpack _ -> mk
 
 and assoc_comments_module_type_kind parent_name module_list mtk =
   match mtk with
diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
index 08ab581f40..7cfb9890c9 100644
--- a/ocamldoc/odoc_html.ml
+++ b/ocamldoc/odoc_html.ml
@@ -1229,6 +1229,18 @@ class html =
           bs b "<code class=\"type\">module type of ";
           bs b (self#create_fully_qualified_module_idents_links father s);
           bs b "</code>"
+      | Module_unpack (code, mta) ->
+          bs b "<code class=\"type\">";
+          begin
+            match mta.mta_module with
+              None ->
+                bs b (self#create_fully_qualified_module_idents_links father (self#escape code))
+            | Some mt ->
+                let (html_file, _) = Naming.html_files mt.mt_name in
+                bp b " <a href=\"%s\">%s</a> " html_file (self#escape code)
+          end;
+          bs b "</code>"
+
 
     method html_of_module_parameter b father p =
       let (s_functor,s_arrow) =
diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli
index 73dee84065..4dc569547f 100644
--- a/ocamldoc/odoc_info.mli
+++ b/ocamldoc/odoc_info.mli
@@ -448,6 +448,7 @@ module Module :
       | Module_constraint of module_kind * module_type_kind
                      (** A module constraint by a module type. *)
       | Module_typeof of string (** by now only the code of the module expression *)
+      | Module_unpack of string * module_type_alias (** code of the expression and module type alias *)
 
     (** Representation of a module. *)
     and t_module = Odoc_module.t_module =
diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml
index a9ecc5e046..3750996a45 100644
--- a/ocamldoc/odoc_latex.ml
+++ b/ocamldoc/odoc_latex.ml
@@ -664,6 +664,11 @@ class latex =
             [ Code "module type of ";
               Code (self#relative_idents father s);
             ]
+      | Module_unpack (s, _) ->
+          self#latex_of_text fmt
+            [
+              Code (self#relative_idents father s);
+            ]
 
     method latex_of_class_kind fmt father kind =
       match kind with
diff --git a/ocamldoc/odoc_module.ml b/ocamldoc/odoc_module.ml
index d95331b25c..cc1fe02ca8 100644
--- a/ocamldoc/odoc_module.ml
+++ b/ocamldoc/odoc_module.ml
@@ -61,6 +61,7 @@ and module_kind =
   | Module_with of module_type_kind * string
   | Module_constraint of module_kind * module_type_kind
   | Module_typeof of string (** by now only the code of the module expression *)
+  | Module_unpack of string * module_type_alias (** code of the expression and module type alias *)
 
 (** Representation of a module. *)
 and t_module = {
@@ -245,7 +246,8 @@ let rec module_elements ?(trans=true) m =
             m_code_intf = None ;
             m_text_only = false ;
           }
-    | Module_typeof s -> []
+    | Module_typeof _ -> []
+    | Module_unpack _ -> []
 (*
    module_type_elements ~trans: trans
    { mt_name = "" ; mt_info = None ; mt_type = None ;
@@ -404,8 +406,8 @@ and module_parameters ?(trans=true) m =
     | Module_struct _
     | Module_apply _
     | Module_with _
-    | Module_typeof _ ->
-        []
+    | Module_typeof _
+    | Module_unpack _ -> []
   in
   iter m.m_kind
 
diff --git a/ocamldoc/odoc_to_text.ml b/ocamldoc/odoc_to_text.ml
index e3f53383f3..a3db5bd9ba 100644
--- a/ocamldoc/odoc_to_text.ml
+++ b/ocamldoc/odoc_to_text.ml
@@ -549,6 +549,12 @@ class virtual to_text =
             s
           in
           [Code code]
+      | Module_unpack (code, _) ->
+          let code = Printf.sprintf "%s%s"
+            (if with_def_syntax then " : " else "")
+            code
+          in
+          [Code code]
 
     (** Return html code for a [module_type_kind].*)
     method text_of_module_type_kind ?(with_def_syntax=true) tk =