Adding "module type of <module-expr>" in the class of <module-type>.

Merge of branches/moduletypeof -r 9636:10226


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

10 files changed, 36 insertions, 3 deletions

diff --git a/boot/ocamlc b/boot/ocamlc
index 0c3ac2507..8989aa7de 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index ad01f71de..99d892e53 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/boot/ocamllex b/boot/ocamllex
index 4ce155c5f..a290fde30 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index d15d868e7..67a0b9f6c 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -865,6 +865,8 @@ module Analyser =
                   "??"
               | Parsetree.Pmty_with (mt, _) ->
                   f mt.Parsetree.pmty_desc
+              | Parsetree.Pmty_typeof _ -> (* TODO *)
+                  "??"
             in
             let name = (f module_type.Parsetree.pmty_desc) in
             let full_name = Odoc_env.full_module_or_module_type_name env name in
@@ -1093,7 +1095,10 @@ module Analyser =
            Module_type_with (k, s)
           )
 
-    (** Analyse of a Parsetree.module_type and a Types.module_type.*)
+      | Parsetree.Pmty_typeof module_expr ->
+          assert false                  (* TODO *)
+
+    (** analyse of a Parsetree.module_type and a Types.module_type.*)
     and analyse_module_kind env current_module_name module_type sig_module_type =
       match module_type.Parsetree.pmty_desc with
         Parsetree.Pmty_ident longident ->
@@ -1156,6 +1161,8 @@ module Analyser =
            let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in
            Module_with (k, s)
           )
+      | Parsetree.Pmty_typeof module_expr ->
+          assert false                  (* TODO *)
 
     (** Analyse of a Parsetree.class_type and a Types.class_type to return a couple
        (class parameters, class_kind).*)
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index 7b79fff5a..8cae99593 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -240,6 +240,8 @@ and search_pos_module m ~pos ~env =
               _, Pwith_type t -> search_pos_type_decl t ~pos ~env
             | _ -> ()
           end
+    | Pmty_typeof md -> 
+        ()   (* TODO? *)
     end
   end
 
diff --git a/parsing/parser.mly b/parsing/parser.mly
index a21fdd859..d12c31446 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -519,6 +519,8 @@ module_type:
       { mkmty(Pmty_functor($3, $5, $8)) }
   | module_type WITH with_constraints
       { mkmty(Pmty_with($1, List.rev $3)) }
+  | MODULE TYPE OF module_expr
+      { mkmty(Pmty_typeof $4) }
   | LPAREN module_type RPAREN
       { $2 }
   | LPAREN module_type error
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index 0307cea54..72cfd3a46 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -207,6 +207,7 @@ and module_type_desc =
   | Pmty_signature of signature
   | Pmty_functor of string * module_type * module_type
   | Pmty_with of module_type * (Longident.t * with_constraint) list
+  | Pmty_typeof of module_expr
 
 and signature = signature_item list
 
diff --git a/parsing/printast.ml b/parsing/printast.ml
index d35f74949..514fbf779 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -510,6 +510,9 @@ and module_type i ppf x =
       line i ppf "Pmty_with\n";
       module_type i ppf mt;
       list i longident_x_with_constraint ppf l;
+  | Pmty_typeof m ->
+      line i ppf "Pmty_typeof\n";
+      module_expr i ppf m
 
 and signature i ppf x = list i signature_item ppf x
 
diff --git a/tools/depend.ml b/tools/depend.ml
index 57c9fd017..573f399f1 100644
--- a/tools/depend.ml
+++ b/tools/depend.ml
@@ -180,6 +180,7 @@ and add_modtype bv mty =
         (function (_, Pwith_type td) -> add_type_declaration bv td
                 | (_, Pwith_module lid) -> addmodule bv lid)
         cstrl
+  | Pmty_typeof m -> add_module bv m
 
 and add_signature bv = function
     [] -> ()
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 8c590b458..161dbc17d 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -75,6 +75,11 @@ let rm node =
   Stypes.record (Stypes.Ti_mod node);
   node
 
+(* Forward declaration, to be filled in by type_module_type_of *)
+let type_module_type_of_fwd 
+  : (Env.t -> Parsetree.module_expr -> module_type) ref
+  = ref (fun env m -> assert false)
+
 (* Merge one "with" constraint in a signature *)
 
 let rec add_rec_types env = function
@@ -179,6 +184,8 @@ let rec approx_modtype env smty =
       Tmty_functor(id, arg, res)
   | Pmty_with(sbody, constraints) ->
       approx_modtype env sbody
+  | Pmty_typeof smod ->
+      !type_module_type_of_fwd env smod
 
 and approx_sig env ssg =
   match ssg with
@@ -297,6 +304,8 @@ let rec transl_modtype env smty =
             merge_constraint env smty.pmty_loc sg lid sdecl)
           init_sg constraints in
       Mtype.freshen (Tmty_signature final_sg)
+  | Pmty_typeof smod ->
+      !type_module_type_of_fwd env smod
 
 and transl_signature env sg =
   let type_names = ref StringSet.empty
@@ -826,12 +835,20 @@ and type_structure funct_body anchor env sstr scope =
 let type_module = type_module false None
 let type_structure = type_structure false None
 
-(* Fill in the forward declaration *)
+let type_module_type_of env smod =
+  match smod.pmod_desc with
+  | Pmod_ident lid -> (* turn off strengthening in this case *)
+      let (path, mty) = type_module_path env smod.pmod_loc lid in mty
+  | _ ->
+      (type_module env smod).mod_type
+
+(* Fill in the forward declarations *)
 let () =
   Typecore.type_module := type_module;
   Typetexp.transl_modtype_longident := transl_modtype_longident;
   Typetexp.transl_modtype := transl_modtype;
-  Typecore.type_open := type_open
+  Typecore.type_open := type_open;
+  type_module_type_of_fwd := type_module_type_of
 
 (* Normalize types in a signature *)