Merge the letopenin branch in (svn merge -r9386:9397 /svn/ocaml/branc…

…hes/letopenin) and update Changes.

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

Changes

@@ -26,6 +26,8 @@ Language features:
   New kind of module expression, to unpack a first-class value as a module: (val EXPR : PT).
   PT is a package type of the form "S" or
   "S with type t1 = ... and ... and type tn = ..." (S refers to a module type).
+- Local opening of modules in a subexpression.
+  Syntax: "let open M in e", or "M.(e)"
 
 Compilers and toplevel:
 - New warning (activated by the warning code 'R') to signal

parsing/parser.mly

@@ -827,6 +827,10 @@ expr:
       { mkexp(Pexp_let($2, List.rev $3, $5)) }
   | LET MODULE UIDENT module_binding IN seq_expr
       { mkexp(Pexp_letmodule($3, $4, $6)) }
+  | LET OPEN mod_longident IN seq_expr
+      { mkexp(Pexp_open($3, $5)) }
+  | mod_longident DOT LPAREN seq_expr RPAREN
+      { mkexp(Pexp_open($1, $4)) }
   | FUNCTION opt_bar match_cases
       { mkexp(Pexp_function("", None, List.rev $3)) }
   | FUN labeled_simple_pattern fun_def

parsing/parsetree.mli

@@ -117,6 +117,7 @@ and expression_desc =
   | Pexp_object of class_structure
   | Pexp_newtype of string * expression
   | Pexp_pack of module_expr * package_type
+  | Pexp_open of Longident.t * expression
 
 (* Value descriptions *)
 

parsing/printast.ml

@@ -319,6 +319,9 @@ and expression i ppf x =
       line i ppf "Pexp_pack %a" fmt_longident p;
       list i package_with ppf l;
       module_expr i ppf me
+  | Pexp_open (m, e) ->
+      line i ppf "Pexp_open \"%a\"\n" fmt_longident m;
+      expression i ppf e
 
 and value_description i ppf x =
   line i ppf "value_description\n";

tools/depend.ml

@@ -160,6 +160,7 @@ let rec add_expr bv exp =
       add_pattern bv pat; List.iter (add_class_field bv) fieldl
   | Pexp_newtype (_, e) -> add_expr bv e
   | Pexp_pack (m, _) -> add_module bv m
+  | Pexp_open (m, e) -> addmodule bv m; add_expr bv e
 and add_pat_expr_list bv pel =
   List.iter (fun (p, e) -> add_pattern bv p; add_expr bv e) pel
 

tools/ocamlprof.ml

@@ -285,8 +285,8 @@ and rw_exp iflag sexp =
   | Pexp_object (_, fieldl) ->
       List.iter (rewrite_class_field iflag) fieldl
 
-  | Pexp_newtype (_, sexp) ->
-      rewrite_exp iflag sexp
+  | Pexp_newtype (_, sexp) -> rewrite_exp iflag sexp
+  | Pexp_open (_, e) -> rewrite_exp iflag e
   | Pexp_pack (smod, _) -> rewrite_mod iflag smod
 
 and rewrite_ifbody iflag ghost sifbody =

typing/typecore.ml

@@ -71,6 +71,12 @@ let type_module =
   ref ((fun env md -> assert false) :
        Env.t -> Parsetree.module_expr -> Typedtree.module_expr)
 
+(* Forward declaration, to be filled in by Typemod.type_open *)
+
+let type_open =
+  ref (fun _ -> assert false)
+
+
 (* Forward declaration, to be filled in by Typeclass.class_structure *)
 let type_object =
   ref (fun env s -> assert false :
@@ -1656,7 +1662,6 @@ let rec type_exp env sexp =
       (* non-expansive if the body is non-expansive, so we don't introduce
          any new extra node in the typed AST. *)
       re { body with exp_loc = sexp.pexp_loc; exp_type = ety }
-
   | Pexp_pack (m, (p, l)) ->
       let loc = sexp.pexp_loc in
       let l, mty = Typetexp.create_package_mty loc env (p, l) in
@@ -1669,6 +1674,8 @@ let rec type_exp env sexp =
         exp_loc = loc;
         exp_type = create_package_type loc env (p, l);
         exp_env = env }
+  | Pexp_open (lid, e) ->
+      type_exp (!type_open env sexp.pexp_loc lid) e
 
 and type_argument env sarg ty_expected' =
   (* ty_expected' may be generic *)

typing/typecore.mli

@@ -109,6 +109,8 @@ val report_error: formatter -> error -> unit
 
 (* Forward declaration, to be filled in by Typemod.type_module *)
 val type_module: (Env.t -> Parsetree.module_expr -> Typedtree.module_expr) ref
+(* Forward declaration, to be filled in by Typemod.type_open *)
+val type_open: (Env.t -> Location.t -> Longident.t -> Env.t) ref
 (* Forward declaration, to be filled in by Typeclass.class_structure *)
 val type_object:
   (Env.t -> Location.t -> Parsetree.class_structure ->

typing/typemod.ml

@@ -63,6 +63,13 @@ let type_module_path env loc lid =
   with Not_found ->
     raise(Error(loc, Unbound_module lid))
 
+(* Compute the environment after opening a module *)
+
+let type_open env loc lid =
+  let (path, mty) = type_module_path env loc lid in
+  let sg = extract_sig_open env loc mty in
+  Env.open_signature path sg env
+
 (* Record a module type *)
 let rm node =
   Stypes.record (Stypes.Ti_mod node);
@@ -202,10 +209,7 @@ and approx_sig env ssg =
           let (id, newenv) = Env.enter_modtype name info env in
           Tsig_modtype(id, info) :: approx_sig newenv srem
       | Psig_open lid ->
-          let (path, mty) = type_module_path env item.psig_loc lid in
-          let sg = extract_sig_open env item.psig_loc mty in
-          let newenv = Env.open_signature path sg env in
-          approx_sig newenv srem
+          approx_sig (type_open env item.psig_loc lid) srem
       | Psig_include smty ->
           let mty = approx_modtype env smty in
           let sg = Subst.signature Subst.identity
@@ -343,10 +347,7 @@ and transl_signature env sg =
             let rem = transl_sig newenv srem in
             Tsig_modtype(id, info) :: rem
         | Psig_open lid ->
-            let (path, mty) = type_module_path env item.psig_loc lid in
-            let sg = extract_sig_open env item.psig_loc mty in
-            let newenv = Env.open_signature path sg env in
-            transl_sig newenv srem
+            transl_sig (type_open env item.psig_loc lid) srem
         | Psig_include smty ->
             let mty = transl_modtype env smty in
             let sg = Subst.signature Subst.identity
@@ -757,9 +758,7 @@ and type_structure funct_body anchor env sstr scope =
          Tsig_modtype(id, Tmodtype_manifest mty) :: sig_rem,
          final_env)
     | {pstr_desc = Pstr_open lid; pstr_loc = loc} :: srem ->
-        let (path, mty) = type_module_path env loc lid in
-        let sg = extract_sig_open env loc mty in
-        type_struct (Env.open_signature path sg env) srem
+        type_struct (type_open env loc lid) srem
     | {pstr_desc = Pstr_class cl; pstr_loc = loc} :: srem ->
          List.iter
            (fun {pci_name = name} -> check "type" loc type_names name)
@@ -831,7 +830,8 @@ let type_structure = type_structure false None
 let () =
   Typecore.type_module := type_module;
   Typetexp.transl_modtype_longident := transl_modtype_longident;
-  Typetexp.transl_modtype := transl_modtype
+  Typetexp.transl_modtype := transl_modtype;
+  Typecore.type_open := type_open
 
 (* Normalize types in a signature *)
 

typing/unused_var.ml

@@ -175,6 +175,7 @@ and expression ppf tbl e =
   | Pexp_object cs -> class_structure ppf tbl cs;
   | Pexp_newtype (_, e) -> expression ppf tbl e
   | Pexp_pack (me, _) -> module_expr ppf tbl me
+  | Pexp_open (_, e) -> expression ppf tbl e
 
 and expression_option ppf tbl eo =
   match eo with