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

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).*)

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
 

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

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
 

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
 

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
     [] -> ()

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 *)