diff --git a/driver/compmisc.ml b/driver/compmisc.ml
index 47f69077a4a8..4f075f98826d 100644
--- a/driver/compmisc.ml
+++ b/driver/compmisc.ml
@@ -43,9 +43,10 @@ let init_path ?(dir="") native =
 
 let open_implicit_module m env =
   let open Asttypes in
-  let lid = {loc = Location.in_file "command line";
-             txt = Longident.parse m } in
-  snd (Typemod.type_open_ Override env lid.loc lid)
+  let loc = Location.in_file "command line" in
+  let lid = {loc; txt = Longident.parse m } in
+  let me = Parsetree.({pmod_desc=Pmod_ident lid; pmod_loc=loc; pmod_attributes=[]}) in
+  snd (Typemod.type_open_ ?toplevel:None false Override env lid.loc me)
 
 let initial_env () =
   Ident.reinit();
diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml
index 2e0657bfd3e7..2fe3ce77c3b6 100644
--- a/ocamldoc/odoc_analyse.ml
+++ b/ocamldoc/odoc_analyse.ml
@@ -39,9 +39,11 @@ let initial_env () =
   in
   let open_mod env m =
     let open Asttypes in
-    let lid = {loc = Location.in_file "ocamldoc command line";
-               txt = Longident.parse m } in
-    snd (Typemod.type_open_ Override env lid.loc lid) in
+    let loc = Location.in_file "ocamldoc command line" in
+    let lid = {loc; txt = Longident.parse m } in
+    let me = Parsetree.({pmod_desc=Pmod_ident lid;
+                         pmod_loc=loc; pmod_attributes=[]}) in
+    snd (Typemod.type_open_ ?toplevel:None false Override env lid.loc me) in
   (* Open the list of modules given as arguments of the "-open" flag
      The list is reversed to open the modules in the left-to-right order *)
   let to_open = List.rev !Clflags.open_modules in
diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml
index ac1fc40da5ce..29dfe3b47b57 100644
--- a/parsing/ast_helper.ml
+++ b/parsing/ast_helper.ml
@@ -407,9 +407,9 @@ end
 
 module Opn = struct
   let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
-        ?(override = Fresh) lid =
+        ?(override = Fresh) expr =
     {
-     popen_lid = lid;
+     popen_expr = expr;
      popen_override = override;
      popen_loc = loc;
      popen_attributes = add_docs_attrs docs attrs;
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index 0a216bdb56ea..022a543508ef 100644
--- a/parsing/ast_helper.mli
+++ b/parsing/ast_helper.mli
@@ -169,8 +169,8 @@ module Exp:
     val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression
     val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
     val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression
-    val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression
-               -> expression
+    val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid
+              -> expression -> expression
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression
     val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression
 
@@ -323,7 +323,7 @@ module Mb:
 module Opn:
   sig
     val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs ->
-      ?override:override_flag -> lid -> open_description
+      ?override:override_flag -> module_expr -> open_description
   end
 
 (** Includes *)
diff --git a/parsing/ast_invariants.ml b/parsing/ast_invariants.ml
index 31ee17eb9b30..834a792ddcb9 100644
--- a/parsing/ast_invariants.ml
+++ b/parsing/ast_invariants.ml
@@ -117,7 +117,7 @@ let iterator =
   in
   let open_description self opn =
     super.open_description self opn;
-    simple_longident opn.popen_lid
+    super.module_expr self opn.popen_expr
   in
   let with_constraint self wc =
     super.with_constraint self wc;
diff --git a/parsing/ast_iterator.ml b/parsing/ast_iterator.ml
index 8518438d829c..479ba62a996b 100755
--- a/parsing/ast_iterator.ml
+++ b/parsing/ast_iterator.ml
@@ -526,8 +526,8 @@ let default_iterator =
 
 
     open_description =
-      (fun this {popen_lid; popen_override = _; popen_attributes; popen_loc} ->
-         iter_loc this popen_lid;
+      (fun this {popen_expr; popen_override = _; popen_attributes; popen_loc} ->
+         this.module_expr this popen_expr;
          this.location this popen_loc;
          this.attributes this popen_attributes
       );
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index 4962cc2cdbdf..5232efd6e7ef 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -561,8 +561,8 @@ let default_mapper =
 
 
     open_description =
-      (fun this {popen_lid; popen_override; popen_attributes; popen_loc} ->
-         Opn.mk (map_loc this popen_lid)
+      (fun this {popen_expr; popen_override; popen_attributes; popen_loc} ->
+         Opn.mk (this.module_expr this popen_expr)
            ~override:popen_override
            ~loc:(this.location this popen_loc)
            ~attrs:(this.attributes this popen_attributes)
diff --git a/parsing/depend.ml b/parsing/depend.ml
index 8703ffe0199f..de666323b995 100644
--- a/parsing/depend.ml
+++ b/parsing/depend.ml
@@ -363,7 +363,10 @@ and add_sig_item (bv, m) item =
       end;
       (bv, m)
   | Psig_open od ->
-      (open_module bv od.popen_lid.txt, m)
+      let Node (s, m') = add_module_binding bv od.popen_expr in
+      add_names s;
+      let add = StringMap.fold StringMap.add m' in
+      (add bv, add m)
   | Psig_include incl ->
       let Node (s, m') = add_modtype_binding bv incl.pincl_mod in
       add_names s;
@@ -454,7 +457,10 @@ and add_struct_item (bv, m) item : _ StringMap.t * _ StringMap.t =
       end;
       (bv, m)
   | Pstr_open od ->
-      (open_module bv od.popen_lid.txt, m)
+      let Node (s, m') = add_module_binding bv od.popen_expr in
+      add_names s;
+      let add = StringMap.fold StringMap.add m' in
+      (add bv, add m)
   | Pstr_class cdl ->
       List.iter (add_class_declaration bv) cdl; (bv, m)
   | Pstr_class_type cdtl ->
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 2dc49aa420a2..58b95c29aa2b 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -917,9 +917,9 @@ signature_item:
         mksig(Psig_attribute $1) }
 ;
 open_statement:
-  | OPEN override_flag ext_attributes mod_longident post_item_attributes
+  | OPEN override_flag ext_attributes module_expr post_item_attributes
       { let (ext, attrs) = $3 in
-        Opn.mk (mkrhs $4 4) ~override:$2 ~attrs:(attrs@$5)
+        Opn.mk $4 ~override:$2 ~attrs:(attrs@$5)
           ~loc:(symbol_rloc()) ~docs:(symbol_docs ())
       , ext}
 ;
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index 1155ddc9ec0f..a1029ce15a10 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -727,7 +727,7 @@ and module_type_declaration =
 
 and open_description =
     {
-     popen_lid: Longident.t loc;
+     popen_expr: module_expr;
      popen_override: override_flag;
      popen_loc: Location.t;
      popen_attributes: attributes;
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index ff352c576c6d..4eb2afb552b2 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -989,7 +989,7 @@ and signature_item ctxt f x : unit =
   | Psig_open od ->
       pp f "@[<hov2>open%s@ %a@]%a"
         (override od.popen_override)
-        longident_loc od.popen_lid
+        (module_expr ctxt) od.popen_expr
         (item_attributes ctxt) od.popen_attributes
   | Psig_include incl ->
       pp f "@[<hov2>include@ %a@]%a"
@@ -1187,7 +1187,7 @@ and structure_item ctxt f x =
   | Pstr_open od ->
       pp f "@[<2>open%s@;%a@]%a"
         (override od.popen_override)
-        longident_loc od.popen_lid
+        (module_expr ctxt) od.popen_expr
         (item_attributes ctxt) od.popen_attributes
   | Pstr_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
       pp f "@[<hov2>module@ type@ %s%a@]%a"
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 6e167b3e47be..94d9d4197015 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -680,9 +680,9 @@ and signature_item i ppf x =
       attributes i ppf x.pmtd_attributes;
       modtype_declaration i ppf x.pmtd_type
   | Psig_open od ->
-      line i ppf "Psig_open %a %a\n"
+      line i ppf "Psig_open %a\n%a\n"
         fmt_override_flag od.popen_override
-        fmt_longident_loc od.popen_lid;
+        (module_expr i) od.popen_expr;
       attributes i ppf od.popen_attributes
   | Psig_include incl ->
       line i ppf "Psig_include\n";
@@ -787,9 +787,9 @@ and structure_item i ppf x =
       attributes i ppf x.pmtd_attributes;
       modtype_declaration i ppf x.pmtd_type
   | Pstr_open od ->
-      line i ppf "Pstr_open %a %a\n"
+      line i ppf "Pstr_open %a\n%a\n"
         fmt_override_flag od.popen_override
-        fmt_longident_loc od.popen_lid;
+        (module_expr i) od.popen_expr;
       attributes i ppf od.popen_attributes
   | Pstr_class (l) ->
       line i ppf "Pstr_class\n";
diff --git a/testsuite/tests/parsing/shortcut_ext_attr.ml.reference b/testsuite/tests/parsing/shortcut_ext_attr.ml.reference
index c31013494a95..50acd0afbdfa 100644
--- a/testsuite/tests/parsing/shortcut_ext_attr.ml.reference
+++ b/testsuite/tests/parsing/shortcut_ext_attr.ml.reference
@@ -756,7 +756,10 @@
     Pstr_extension "foo"
     [
       structure_item (shortcut_ext_attr.ml[88,1754+0]..[88,1754+16])
-        Pstr_open Fresh "M" (shortcut_ext_attr.ml[88,1754+15]..[88,1754+16])
+        Pstr_open Fresh
+        module_expr (shortcut_ext_attr.ml[88,1754+15]..[88,1754+16])
+          Pmod_ident "M" (shortcut_ext_attr.ml[88,1754+15]..[88,1754+16])
+
           attribute "foo"
             []
     ]
@@ -929,7 +932,10 @@
             Psig_extension "foo"
             [
               signature_item (shortcut_ext_attr.ml[109,2116+2]..[109,2116+18])
-                Psig_open Fresh "M" (shortcut_ext_attr.ml[109,2116+17]..[109,2116+18])
+                Psig_open Fresh
+                module_expr (shortcut_ext_attr.ml[109,2116+17]..[109,2116+18])
+                  Pmod_ident "M" (shortcut_ext_attr.ml[109,2116+17]..[109,2116+18])
+
                   attribute "foo"
                     []
             ]
diff --git a/testsuite/tests/typing-modules/open-struct.ml b/testsuite/tests/typing-modules/open-struct.ml
new file mode 100644
index 000000000000..43970d05ad49
--- /dev/null
+++ b/testsuite/tests/typing-modules/open-struct.ml
@@ -0,0 +1,101 @@
+type t = A
+
+module M = struct
+    open struct type t' = t end
+    type t = B of t * t' | C
+end
+
+(* test *)
+include struct
+  open M
+  let test = B (B (C, A), A)
+end
+[%%expect{|
+type t = A
+module M : sig type t = B of t * t | C end
+val test : M.t = M.B (M.B (M.C, A), A)
+|}];;
+
+include struct
+  open struct let aux x y = x / y end
+  let f x = aux x 2
+  let g y = aux 3 y
+end
+[%%expect{|
+val f : int -> int = <fun>
+val g : int -> int = <fun>
+|}];;
+
+include struct
+  open struct exception Interrupt end
+  let run () =
+    raise Interrupt
+  let () =
+    match run() with exception Interrupt -> () | _ -> assert false
+end
+[%%expect{|
+val run : unit -> 'a = <fun>
+|}];;
+
+module type S = sig
+  open struct
+    open struct
+      type t' = char
+    end
+    type t = t' -> int end
+  val x : t
+end
+
+module M : S = struct
+  let x = Char.code
+end
+[%%expect{|
+module type S = sig val x : char -> int end
+module M : S
+|}];;
+
+open struct
+  open struct let counter = ref 0 end
+  let inc () = incr counter
+  let dec () = decr counter
+  let current () = !counter
+end
+
+let () =
+  inc(); inc(); dec ();
+  assert (current () = 1)
+[%%expect{|
+|}];;
+
+include struct open struct type t = T end let x = T end
+[%%expect{|
+Line _, characters 15-41:
+Error: The module identifier M#7 cannot be eliminated from val x : M#7.t
+|}];;
+
+module type S = sig open struct assert false end end;;
+[%%expect{|
+module type S = sig  end
+|}];;
+
+module type S = sig open struct type t = int end val x : t end;;
+[%%expect{|
+module type S = sig val x : int end
+|}];;
+
+module type S = sig
+  open struct type t = int end
+  type s = t
+end
+[%%expect{|
+module type S = sig type s = int end
+|}]
+
+module type T = sig type s = int end
+module F(X:S) : T = X
+module G(X:T) : S = X
+[%%expect{|
+module type T = sig type s = int end
+module F : functor (X : S) -> T
+module G : functor (X : T) -> S
+|}]
diff --git a/typing/printtyped.ml b/typing/printtyped.ml
index 78e1b60a5b6e..7e9686ae6c52 100644
--- a/typing/printtyped.ml
+++ b/typing/printtyped.ml
@@ -224,8 +224,8 @@ and pattern i ppf x =
         line i ppf "Tpat_type %a\n" fmt_path id;
         attributes i ppf attrs;
         pattern i ppf { x with pat_extra = rem }
-    | (Tpat_open (id,_,_), _, attrs)::rem ->
-        line i ppf "Tpat_open \"%a\"\n" fmt_path id;
+    | (Tpat_open (id,_), _, attrs)::rem ->
+        line i ppf "Tpat_open \"%a\"\n" fmt_longident id;
         attributes i ppf attrs;
         pattern i ppf { x with pat_extra = rem }
     | [] ->
@@ -270,8 +270,8 @@ and expression_extra i ppf x attrs =
       attributes i ppf attrs;
       option i core_type ppf cto1;
       core_type i ppf cto2;
-  | Texp_open (ovf, m, _, _) ->
-      line i ppf "Texp_open %a \"%a\"\n" fmt_override_flag ovf fmt_path m;
+  | Texp_open (ovf, lid, _) ->
+      line i ppf "Texp_open %a \"%a\"\n" fmt_override_flag ovf fmt_longident lid;
       attributes i ppf attrs;
   | Texp_poly cto ->
       line i ppf "Texp_poly\n";
@@ -662,9 +662,8 @@ and signature_item i ppf x =
       attributes i ppf x.mtd_attributes;
       modtype_declaration i ppf x.mtd_type
   | Tsig_open od ->
-      line i ppf "Tsig_open %a %a\n"
-           fmt_override_flag od.open_override
-           fmt_path od.open_path;
+      line i ppf "Tsig_open %a\n"
+        fmt_override_flag od.open_override;
       attributes i ppf od.open_attributes
   | Tsig_include incl ->
       line i ppf "Tsig_include\n";
@@ -767,9 +766,8 @@ and structure_item i ppf x =
       attributes i ppf x.mtd_attributes;
       modtype_declaration i ppf x.mtd_type
   | Tstr_open od ->
-      line i ppf "Tstr_open %a %a\n"
-           fmt_override_flag od.open_override
-           fmt_path od.open_path;
+      line i ppf "Tstr_open %a\n"
+        fmt_override_flag od.open_override;
       attributes i ppf od.open_attributes
   | Tstr_class (l) ->
       line i ppf "Tstr_class\n";
diff --git a/typing/tast_mapper.ml b/typing/tast_mapper.ml
index 0873dd4c9ee4..a44ac52e1b64 100644
--- a/typing/tast_mapper.ml
+++ b/typing/tast_mapper.ml
@@ -124,7 +124,8 @@ let structure_item sub {str_desc; str_loc; str_env} =
           (List.map (tuple3 id id (sub.class_type_declaration sub)) list)
     | Tstr_include incl ->
         Tstr_include (include_infos (sub.module_expr sub) incl)
-    | Tstr_open _
+    | Tstr_open od ->
+        Tstr_open {od with open_expr = sub.module_expr sub od.open_expr}
     | Tstr_attribute _ as d -> d
   in
   {str_desc; str_env; str_loc}
@@ -186,7 +187,7 @@ let pat sub x =
   let extra = function
     | Tpat_type _
     | Tpat_unpack as d -> d
-    | Tpat_open (path,loc,env) ->  Tpat_open (path, loc, sub.env sub env)
+    | Tpat_open (loc,env) ->  Tpat_open (loc, sub.env sub env)
     | Tpat_constraint ct -> Tpat_constraint (sub.typ sub ct)
   in
   let pat_env = sub.env sub x.pat_env in
@@ -216,8 +217,8 @@ let expr sub x =
         Texp_constraint (sub.typ sub cty)
     | Texp_coerce (cty1, cty2) ->
         Texp_coerce (opt (sub.typ sub) cty1, sub.typ sub cty2)
-    | Texp_open (ovf, path, loc, env) ->
-        Texp_open (ovf, path, loc, sub.env sub env)
+    | Texp_open (ovf, loc, env) ->
+        Texp_open (ovf, loc, sub.env sub env)
     | Texp_newtype _ as d -> d
     | Texp_poly cto -> Texp_poly (opt (sub.typ sub) cto)
   in
@@ -387,7 +388,8 @@ let signature_item sub x =
     | Tsig_class_type list ->
         Tsig_class_type
           (List.map (sub.class_type_declaration sub) list)
-    | Tsig_open _
+    | Tsig_open od ->
+        Tsig_open {od with open_expr = sub.module_expr sub od.open_expr}
     | Tsig_attribute _ as d -> d
   in
   {x with sig_desc; sig_env}
diff --git a/typing/typecore.ml b/typing/typecore.ml
index a06b8c283d35..26806018104e 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -1366,12 +1366,13 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~explode ~env
       k { p with pat_extra =
         (Tpat_type (path, lid), loc, sp.ppat_attributes) :: p.pat_extra }
   | Ppat_open (lid,p) ->
-      let path, new_env =
-        !type_open Asttypes.Fresh !env sp.ppat_loc lid in
+      let me = {pmod_desc=Pmod_ident lid; pmod_loc=lid.loc; pmod_attributes=[]} in
+      let _tme, new_env =
+        !type_open Asttypes.Fresh !env sp.ppat_loc me in
       let new_env = ref new_env in
       type_pat ~env:new_env p expected_ty ( fun p ->
         env := Env.copy_local !env ~from:!new_env;
-        k { p with pat_extra =( Tpat_open (path,lid,!new_env),
+        k { p with pat_extra =( Tpat_open (lid,!new_env),
                             loc, sp.ppat_attributes) :: p.pat_extra }
       )
   | Ppat_exception _ ->
@@ -1853,7 +1854,9 @@ let contains_gadt env p =
         with Not_found -> ()
         end; iter_ppat (loop env) p
       | Ppat_open (lid,sub_p) ->
-        let _, new_env = !type_open Asttypes.Override env p.ppat_loc lid in
+        let me = {pmod_desc=Pmod_ident lid; pmod_loc=lid.loc;
+                  pmod_attributes=[]} in
+        let _, new_env = !type_open Asttypes.Override env p.ppat_loc me in
         loop new_env sub_p
     | _ -> iter_ppat (loop env) p
   in
@@ -2966,10 +2969,12 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
         exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_open (ovf, lid, e) ->
-      let (path, newenv) = !type_open ovf env sexp.pexp_loc lid in
+      let me = {pmod_desc=Pmod_ident lid; pmod_loc=lid.loc;
+                pmod_attributes=[]} in
+      let (_tme, newenv) = !type_open ovf env sexp.pexp_loc me in
       let exp = type_expect newenv e ty_expected in
       { exp with
-        exp_extra = (Texp_open (ovf, path, lid, newenv), loc,
+        exp_extra = (Texp_open (ovf, lid, newenv), loc,
                      sexp.pexp_attributes) ::
                       exp.exp_extra;
       }
diff --git a/typing/typecore.mli b/typing/typecore.mli
index 7b64ee343cb5..65c3c10d34ce 100644
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -135,7 +135,7 @@ val report_error: Env.t -> formatter -> error -> unit
 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:
-    (override_flag -> Env.t -> Location.t -> Longident.t loc -> Path.t * Env.t)
+    (override_flag -> Env.t -> Location.t -> Parsetree.module_expr -> Typedtree.module_expr * Env.t)
     ref
 (* Forward declaration, to be filled in by Typeclass.class_structure *)
 val type_object:
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index db4440c18f78..063a9eb56862 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -38,7 +38,7 @@ type pattern =
 and pat_extra =
   | Tpat_constraint of core_type
   | Tpat_type of Path.t * Longident.t loc
-  | Tpat_open of Path.t * Longident.t loc * Env.t
+  | Tpat_open of Longident.t loc * Env.t
   | Tpat_unpack
 
 and pattern_desc =
@@ -69,7 +69,7 @@ and expression =
 and exp_extra =
   | Texp_constraint of core_type
   | Texp_coerce of core_type option * core_type
-  | Texp_open of override_flag * Path.t * Longident.t loc * Env.t
+  | Texp_open of override_flag * Longident.t loc * Env.t
   | Texp_poly of core_type option
   | Texp_newtype of string
 
@@ -330,8 +330,7 @@ and module_type_declaration =
 
 and open_description =
     {
-     open_path: Path.t;
-     open_txt: Longident.t loc;
+     open_expr: module_expr;
      open_override: override_flag;
      open_loc: Location.t;
      open_attributes: attribute list;
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index ee26bca3e17b..f3e4107338bc 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -56,7 +56,7 @@ and pat_extra =
                            where [disjunction] is a [Tpat_or _] representing the
                            branches of [tconst].
          *)
-  | Tpat_open of Path.t * Longident.t loc * Env.t
+  | Tpat_open of Longident.t loc * Env.t
   | Tpat_unpack
         (** (module P)     { pat_desc  = Tpat_var "P"
                            ; pat_extra = (Tpat_unpack, _, _) :: ... }
@@ -123,7 +123,7 @@ and exp_extra =
         (** E :> T           [Texp_coerce (None, T)]
             E : T0 :> T      [Texp_coerce (Some T0, T)]
          *)
-  | Texp_open of override_flag * Path.t * Longident.t loc * Env.t
+  | Texp_open of override_flag * Longident.t loc * Env.t
         (** let open[!] M in    [Texp_open (!, P, M, env)]
                                 where [env] is the environment after opening [P]
          *)
@@ -450,8 +450,7 @@ and module_type_declaration =
 
 and open_description =
     {
-     open_path: Path.t;
-     open_txt: Longident.t loc;
+     open_expr: module_expr;
      open_override: override_flag;
      open_loc: Location.t;
      open_attributes: attribute list;
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 77de1f29261b..9b69bca03089 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -43,6 +43,8 @@ type error =
   | Recursive_module_require_explicit_type
   | Apply_generative
   | Cannot_scrape_alias of Path.t
+  | Invalid_open of Parsetree.module_expr
+  | Cannot_eliminate_anon_module of Ident.t * signature
 
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
@@ -82,29 +84,126 @@ let extract_sig_open env loc mty =
 
 (* Compute the environment after opening a module *)
 
-let type_open_ ?toplevel ovf env loc lid =
-  let path = Typetexp.lookup_module ~load:true env lid.loc lid.txt in
-  match Env.open_signature ~loc ?toplevel ovf path env with
-  | Some env -> path, env
-  | None ->
-      let md = Env.find_module path env in
-      ignore (extract_sig_open env lid.loc md.md_type);
-      assert false
-
-let type_open ?toplevel env sod =
-  let (path, newenv) =
-    type_open_ ?toplevel sod.popen_override env sod.popen_loc sod.popen_lid
+let type_module_fwd : (Env.t -> Parsetree.module_expr ->
+                       Typedtree.module_expr) ref =
+  ref (fun _ _ -> assert false)
+
+let mod_ident_counter = ref 0
+let generated_module_ident = ref []
+let generated_module_ident_in_sig = ref []
+
+let push_current_mid (mi, md, env) in_sig =
+  if in_sig then
+    generated_module_ident_in_sig := (mi, md, env) :: !generated_module_ident
+  else
+    generated_module_ident := (mi, md, env) :: !generated_module_ident
+
+let pop_current_mid in_sig =
+  let slots =
+    if in_sig then generated_module_ident_in_sig
+    else generated_module_ident in
+  let slot = List.hd !slots in
+  slots := List.tl !slots;
+  slot
+
+let gen_mod_ident () =
+  let n = !mod_ident_counter in
+  incr mod_ident_counter;
+  let ident = Ident.create (Printf.sprintf "M#%d" n) in
+  ident
+
+let saved_full_mod_types = ref []
+let push_mod_type mt =
+  saved_full_mod_types := mt :: !saved_full_mod_types
+let pop_mod_type () =
+  let mt = List.hd !saved_full_mod_types in
+  saved_full_mod_types := List.tl !saved_full_mod_types;
+  mt
+
+let open_struct_level = ref 0
+let enter_struct () = incr open_struct_level
+let leave_struct () = decr open_struct_level
+
+let type_open_ ?toplevel in_sig ovf env loc me =
+  match me.pmod_desc with
+  | Pmod_functor _ | Pmod_unpack _ | Pmod_extension _ ->
+      raise(Error(me.pmod_loc, env, Invalid_open me))
+  | Pmod_ident lid -> begin
+      let path = Typetexp.lookup_module ~load:true env lid.loc lid.txt in
+      match Env.open_signature ~loc ?toplevel ovf path env with
+      | Some env ->
+          let tme =
+            {
+              mod_desc=Tmod_ident (path, lid);
+              mod_loc=lid.loc;
+              mod_type=Mty_ident path;
+              mod_env=env;
+              mod_attributes=me.pmod_attributes
+            } in
+          tme, env
+      | None ->
+          let md = Env.find_module path env in
+          ignore (extract_sig_open env lid.loc md.md_type);
+          assert false
+    end
+  | _ -> begin
+      enter_struct ();
+      let ident = gen_mod_ident () in
+      let tme = !type_module_fwd env me in
+      leave_struct ();
+      begin
+      match tme.mod_type with
+      | Mty_signature _ -> ()
+      | _ -> raise(Error(me.pmod_loc, env, Invalid_open me));
+      end;
+      let full_modtype = pop_mod_type () in
+      let md = {
+        md_type = full_modtype;
+        md_loc = me.pmod_loc;
+        md_attributes = me.pmod_attributes;
+      } in
+      let newenv = Env.enter_module_declaration ident md env in
+      push_current_mid (ident, md, newenv) in_sig;
+      let root = Pident ident in
+      match Env.open_signature ~loc ?toplevel ovf root newenv with
+      | None -> assert false
+      | Some opened_env -> tme, opened_env
+    end
+
+let extract_open od in_sig =
+  match od.open_expr.mod_desc with
+  | Tmod_ident (_, _) -> None
+  | Tmod_structure _ | Tmod_apply _ | Tmod_constraint _ ->
+      let id, md, env =
+        if in_sig then List.hd !generated_module_ident_in_sig
+        else (pop_current_mid false) in
+      let tm =
+        Tstr_module {mb_id=id;
+                     mb_name={txt=Ident.name id; loc=Location.none};
+                     mb_expr = od.open_expr;
+                     mb_attributes=od.open_expr.mod_attributes;
+                     mb_loc=od.open_expr.mod_loc} in
+      Some (tm, md, id, env)
+  | _ -> assert false
+
+let extract_open_struct = function
+  | Tstr_open od -> extract_open od false
+  | _ -> None
+
+let type_open ?toplevel env sod in_sig =
+  let (tme, newenv) =
+    type_open_ ?toplevel in_sig sod.popen_override env sod.popen_loc
+      sod.popen_expr
   in
   let od =
     {
       open_override = sod.popen_override;
-      open_path = path;
-      open_txt = sod.popen_lid;
+      open_expr = tme;
       open_attributes = sod.popen_attributes;
       open_loc = sod.popen_loc;
     }
   in
-  (path, newenv, od)
+  newenv, od
 
 (* Record a module type *)
 let rm node =
@@ -397,7 +496,7 @@ and approx_sig env ssg =
           let (id, newenv) = Env.enter_modtype d.pmtd_name.txt info env in
           Sig_modtype(id, info) :: approx_sig newenv srem
       | Psig_open sod ->
-          let (_path, mty, _od) = type_open env sod in
+          let (mty, _od) = type_open env sod true in
           approx_sig mty srem
       | Psig_include sincl ->
           let smty = sincl.pincl_mod in
@@ -672,11 +771,30 @@ and transl_signature env sg =
             mksig (Tsig_modtype mtd) env loc :: trem,
             sg :: rem,
             final_env
-        | Psig_open sod ->
-            let (_path, newenv, od) = type_open env sod in
+        | Psig_open sod -> begin
+            let (newenv, od) = type_open env sod true in
             let (trem, rem, final_env) = transl_sig newenv srem in
+            let remr = ref rem in
+            begin
+            if !open_struct_level = 0 then
+              begin
+              match extract_open od true with
+              | None -> ()
+              | Some (_, _, id, _) -> begin
+                  let s_rem = Mty_signature rem in begin
+                  match Mtype.nondep_supertype newenv id s_rem with
+                  | Mty_signature rem' -> remr := rem'
+                  | exception Not_found ->
+                      raise(Error(sod.popen_loc, env,
+                                  Cannot_eliminate_anon_module(id, rem)))
+                  | _ -> assert false
+                  end
+                end
+              end else ()
+            end;
             mksig (Tsig_open od) env loc :: trem,
-            rem, final_env
+            !remr, final_env
+          end
         | Psig_include sincl ->
             let smty = sincl.pincl_mod in
             let tmty =
@@ -1380,7 +1498,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
         in
         Tstr_modtype mtd, [sg], newenv
     | Pstr_open sod ->
-        let (_path, newenv, od) = type_open ~toplevel env sod in
+        let (newenv, od) = type_open ~toplevel env sod false in
         Tstr_open od, [], newenv
     | Pstr_class cl ->
         List.iter
@@ -1461,22 +1579,51 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
   let rec type_struct env sstr =
     Ctype.init_def(Ident.current_time());
     match sstr with
-    | [] -> ([], [], env)
-    | pstr :: srem ->
+    | [] -> ([], [], [], env)
+    | pstr :: srem -> begin
         let previous_saved_types = Cmt_format.get_saved_types () in
         let desc, sg, new_env = type_str_item env srem pstr in
         let str = { str_desc = desc; str_loc = pstr.pstr_loc; str_env = env } in
         Cmt_format.set_saved_types (Cmt_format.Partial_structure_item str
                                     :: previous_saved_types);
-        let (str_rem, sig_rem, final_env) = type_struct new_env srem in
-        (str :: str_rem, sg @ sig_rem, final_env)
+        let (str_rem, sig_rem, fsig_rem, final_env) = type_struct new_env srem in
+        match extract_open_struct desc with
+        | Some (tm, md, id, md_env) -> begin
+            let loc = pstr.pstr_loc in
+            let tm_str = {str_desc = tm; str_loc = loc;
+                          str_env = env} in
+            let open_str = {str with str_env = md_env} in
+            let md_sig =
+              Sig_module (id, {md_type=md.Types.md_type; md_loc=loc;
+                               md_attributes = []}, Trec_not) in
+            if !open_struct_level = 0 then begin
+              let s_rem = Mty_signature sig_rem in begin
+              match Mtype.nondep_supertype new_env id s_rem with
+              | Mty_signature sg ->
+                  (tm_str :: open_str :: str_rem, sg,
+                   md_sig :: fsig_rem, final_env)
+              | exception Not_found ->
+                  raise(Error(pstr.pstr_loc, env,
+                              Cannot_eliminate_anon_module(id, sig_rem)))
+              | _ -> assert false
+              end
+            end else
+              (tm_str :: open_str :: str_rem, sig_rem,
+               md_sig :: fsig_rem, final_env)
+          end
+        | None ->
+            (str :: str_rem, sg @ sig_rem, sg @ fsig_rem, final_env)
+      end
   in
   if !Clflags.annotations then
     (* moved to genannot *)
     List.iter (function {pstr_loc = l} -> Stypes.record_phrase l) sstr;
   let previous_saved_types = Cmt_format.get_saved_types () in
   if not toplevel then Builtin_attributes.warning_enter_scope ();
-  let (items, sg, final_env) = type_struct env sstr in
+  let (items, sg, full_sg, final_env) = type_struct env sstr in
+  if !open_struct_level <> 0 then begin
+    push_mod_type (Mty_signature full_sg)
+  end;
   let str = { str_items = items; str_type = sg; str_final_env = final_env } in
   if not toplevel then Builtin_attributes.warning_leave_scope ();
   Cmt_format.set_saved_types
@@ -1584,8 +1731,9 @@ let () =
   Typecore.type_module := type_module_alias;
   Typetexp.transl_modtype_longident := transl_modtype_longident;
   Typetexp.transl_modtype := transl_modtype;
-  Typecore.type_open := type_open_ ?toplevel:None;
+  Typecore.type_open := type_open_ ?toplevel:None false;
   Typecore.type_package := type_package;
+  type_module_fwd := type_module;
   type_module_type_of_fwd := type_module_type_of
 
 
@@ -1825,6 +1973,11 @@ let report_error ppf = function
       fprintf ppf
         "This is an alias for module %a, which is missing"
         path p
+  | Invalid_open _me ->
+      fprintf ppf "Invalid open"
+  | Cannot_eliminate_anon_module (id, sg) ->
+      fprintf ppf "The module identifier %a cannot be \
+        eliminated from %a" ident id signature sg
 
 let report_error env ppf err =
   Printtyp.wrap_printing_env env (fun () -> report_error ppf err)
diff --git a/typing/typemod.mli b/typing/typemod.mli
index fab7cdae5317..e421c141bd97 100644
--- a/typing/typemod.mli
+++ b/typing/typemod.mli
@@ -36,8 +36,9 @@ val transl_signature:
 val check_nongen_schemes:
         Env.t -> Types.signature -> unit
 val type_open_:
-        ?toplevel:bool -> Asttypes.override_flag ->
-        Env.t -> Location.t -> Longident.t Asttypes.loc -> Path.t * Env.t
+        ?toplevel:bool -> bool -> Asttypes.override_flag ->
+        Env.t -> Location.t -> Parsetree.module_expr ->
+        Typedtree.module_expr * Env.t
 val modtype_of_package:
         Env.t -> Location.t ->
         Path.t -> Longident.t list -> type_expr list -> module_type
@@ -74,6 +75,8 @@ type error =
   | Recursive_module_require_explicit_type
   | Apply_generative
   | Cannot_scrape_alias of Path.t
+  | Invalid_open of Parsetree.module_expr
+  | Cannot_eliminate_anon_module of Ident.t * signature
 
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
diff --git a/typing/untypeast.ml b/typing/untypeast.ml
index 0cb58f484a68..10649dcf661d 100644
--- a/typing/untypeast.ml
+++ b/typing/untypeast.ml
@@ -135,7 +135,7 @@ let open_description sub od =
   let attrs = sub.attributes sub od.open_attributes in
   Opn.mk ~loc ~attrs
     ~override:od.open_override
-    (map_loc sub od.open_txt)
+    (sub.module_expr sub od.open_expr)
 
 let structure_item sub item =
   let loc = sub.location sub item.str_loc in
@@ -328,7 +328,7 @@ let exp_extra sub (extra, loc, attrs) sexp =
                      sub.typ sub cty2)
     | Texp_constraint cty ->
         Pexp_constraint (sexp, sub.typ sub cty)
-    | Texp_open (ovf, _path, lid, _) ->
+    | Texp_open (ovf, lid, _) ->
         Pexp_open (ovf, map_loc sub lid, sexp)
     | Texp_poly cto -> Pexp_poly (sexp, map_opt (sub.typ sub) cto)
     | Texp_newtype s -> Pexp_newtype (mkloc s loc, sexp)