Skip to content
Browse files

#5980: explicit way to silence the new warning (open! X).

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13685 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
1 parent e4098f9 commit a3b1c67fffd7de640ee9a0791f1fd0fad965b867 @alainfrisch alainfrisch committed May 16, 2013
View
BIN boot/ocamlc
Binary file not shown.
View
BIN boot/ocamldep
Binary file not shown.
View
BIN boot/ocamllex
Binary file not shown.
View
12 bytecomp/translmod.ml
@@ -316,7 +316,7 @@ and transl_structure fields cc rootpath = function
(transl_structure ext_fields cc rootpath rem)
| Tstr_modtype(id, _, decl) ->
transl_structure fields cc rootpath rem
- | Tstr_open (path, _) ->
+ | Tstr_open _ ->
transl_structure fields cc rootpath rem
| Tstr_class cl_list ->
let ids = List.map (fun (ci,_,_) -> ci.ci_id_class) cl_list in
@@ -373,7 +373,7 @@ let rec defined_idents = function
| Tstr_recmodule decls ->
List.map (fun (id, _, _, _) -> id) decls @ defined_idents rem
| Tstr_modtype(id, _, decl) -> defined_idents rem
- | Tstr_open (path, _) -> defined_idents rem
+ | Tstr_open _ -> defined_idents rem
| Tstr_class cl_list ->
List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ defined_idents rem
| Tstr_class_type cl_list -> defined_idents rem
@@ -393,7 +393,7 @@ let rec more_idents = function
| Tstr_exn_rebind(id, _, path, _) -> more_idents rem
| Tstr_recmodule decls -> more_idents rem
| Tstr_modtype(id, _, decl) -> more_idents rem
- | Tstr_open (path, _) -> more_idents rem
+ | Tstr_open _ -> more_idents rem
| Tstr_class cl_list -> more_idents rem
| Tstr_class_type cl_list -> more_idents rem
| Tstr_include(modl, ids) -> more_idents rem
@@ -415,7 +415,7 @@ and all_idents = function
| Tstr_recmodule decls ->
List.map (fun (id, _, _, _) -> id) decls @ all_idents rem
| Tstr_modtype(id, _, decl) -> all_idents rem
- | Tstr_open (path, _) -> all_idents rem
+ | Tstr_open _ -> all_idents rem
| Tstr_class cl_list ->
List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ all_idents rem
| Tstr_class_type cl_list -> all_idents rem
@@ -510,7 +510,7 @@ let transl_store_structure glob map prims str =
transl_store rootpath (add_idents true ids subst) rem))
| Tstr_modtype(id, _, decl) ->
transl_store rootpath subst rem
- | Tstr_open (path, _) ->
+ | Tstr_open _ ->
transl_store rootpath subst rem
| Tstr_class cl_list ->
let ids = List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list in
@@ -701,7 +701,7 @@ let transl_toplevel_item item =
(make_sequence toploop_setvalue_id idents)
| Tstr_modtype(id, _, decl) ->
lambda_unit
- | Tstr_open (path, _) ->
+ | Tstr_open _ ->
lambda_unit
| Tstr_class cl_list ->
(* we need to use unique names for the classes because there might
View
6 camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
@@ -864,7 +864,7 @@ value varify_constructors var_names =
let e2 = ExSeq loc el in
mkexp loc (Pexp_while (expr e1) (expr e2))
| <:expr@loc< let open $i$ in $e$ >> ->
- mkexp loc (Pexp_open (long_uident i) (expr e))
+ mkexp loc (Pexp_open Fresh (long_uident i) (expr e))
| <:expr@loc< (module $me$ : $pt$) >> ->
mkexp loc (Pexp_constraint (mkexp loc (Pexp_pack (module_expr me)),
Some (mktyp loc (Ptyp_package (package_type pt))), None))
@@ -1008,7 +1008,7 @@ value varify_constructors var_names =
in
[mksig loc (Psig_modtype (with_loc n loc) si) :: l]
| SgOpn loc id ->
- [mksig loc (Psig_open (long_uident id)) :: l]
+ [mksig loc (Psig_open Fresh (long_uident id)) :: l]
| SgTyp loc tdl -> [mksig loc (Psig_type (mktype_decl tdl [])) :: l]
| SgVal loc n t -> [mksig loc (Psig_value (with_loc n loc) (mkvalue_desc loc t [])) :: l]
| <:sig_item@loc< $anti:_$ >> -> error loc "antiquotation in sig_item" ]
@@ -1075,7 +1075,7 @@ value varify_constructors var_names =
[mkstr loc (Pstr_recmodule (module_str_binding mb [])) :: l]
| StMty loc n mt -> [mkstr loc (Pstr_modtype (with_loc n loc) (module_type mt)) :: l]
| StOpn loc id ->
- [mkstr loc (Pstr_open (long_uident id)) :: l]
+ [mkstr loc (Pstr_open Fresh (long_uident id)) :: l]
| StTyp loc tdl -> [mkstr loc (Pstr_type (mktype_decl tdl [])) :: l]
| StVal loc rf bi ->
[mkstr loc (Pstr_value (mkrf rf) (binding bi [])) :: l]
View
6 camlp4/boot/Camlp4.ml
@@ -15167,7 +15167,7 @@ module Struct =
let e2 = ExSeq (loc, el)
in mkexp loc (Pexp_while ((expr e1), (expr e2)))
| Ast.ExOpI (loc, i, e) ->
- mkexp loc (Pexp_open ((long_uident i), (expr e)))
+ mkexp loc (Pexp_open (Fresh, (long_uident i), (expr e)))
| Ast.ExPkg (loc, (Ast.MeTyc (_, me, pt))) ->
mkexp loc
(Pexp_constraint
@@ -15347,7 +15347,7 @@ module Struct =
| _ -> Pmodtype_manifest (module_type mt))
in (mksig loc (Psig_modtype ((with_loc n loc), si))) :: l
| SgOpn (loc, id) ->
- (mksig loc (Psig_open (long_uident id))) :: l
+ (mksig loc (Psig_open (Fresh, long_uident id))) :: l
| SgTyp (loc, tdl) ->
(mksig loc (Psig_type (mktype_decl tdl []))) :: l
| SgVal (loc, n, t) ->
@@ -15457,7 +15457,7 @@ module Struct =
(Pstr_modtype ((with_loc n loc), (module_type mt)))) ::
l
| StOpn (loc, id) ->
- (mkstr loc (Pstr_open (long_uident id))) :: l
+ (mkstr loc (Pstr_open (Fresh, long_uident id))) :: l
| StTyp (loc, tdl) ->
(mkstr loc (Pstr_type (mktype_decl tdl []))) :: l
| StVal (loc, rf, bi) ->
View
2 ocamldoc/odoc_ast.ml
@@ -1418,7 +1418,7 @@ module Analyser =
in
(0, new_env2, [ Element_module_type mt ])
- | Parsetree.Pstr_open longident ->
+ | Parsetree.Pstr_open (_, longident) ->
(* A VOIR : enrichir l'environnement quand open ? *)
let ele_comments = match comment_opt with
None -> []
View
2 otherlibs/labltk/browser/searchid.ml
@@ -206,7 +206,7 @@ let mkpath = function
~f:(fun acc x -> Pdot (acc, x, 0))
let get_fields ~prefix ~sign self =
- let env = open_signature (mkpath prefix) sign initial in
+ let env = open_signature Fresh (mkpath prefix) sign initial in
match (expand_head env self).desc with
Tobject (ty_obj, _) ->
let l,_ = flatten_fields ty_obj in l
View
9 otherlibs/labltk/browser/searchpos.ml
@@ -187,10 +187,10 @@ let rec search_pos_signature l ~pos ~env =
List.fold_left l ~init:env ~f:
begin fun env pt ->
let env = match pt.psig_desc with
- Psig_open id ->
+ Psig_open (ovf, id) ->
let path, mt = lookup_module id.txt env in
begin match mt with
- Mty_signature sign -> open_signature path sign env
+ Mty_signature sign -> open_signature ovf path sign env
| _ -> env
end
| sign_item ->
@@ -220,7 +220,8 @@ let rec search_pos_signature l ~pos ~env =
List.iter l
~f:(fun ci -> search_pos_class_type ci.pci_expr ~pos ~env)
(* The last cases should not happen in generated interfaces *)
- | Psig_open lid -> add_found_sig (`Module, lid.txt) ~env ~loc:pt.psig_loc
+ | Psig_open (_, lid) ->
+ add_found_sig (`Module, lid.txt) ~env ~loc:pt.psig_loc
| Psig_include t -> search_pos_module t ~pos ~env
end;
env
@@ -325,7 +326,7 @@ let dummy_item = Sig_modtype (Ident.create "dummy", Modtype_abstract)
let rec view_signature ?title ?path ?(env = !start_env) ?(detach=false) sign =
let env =
match path with None -> env
- | Some path -> Env.open_signature path sign env in
+ | Some path -> Env.open_signature Fresh path sign env in
let title =
match title, path with Some title, _ -> title
| None, Some path -> string_of_path path
View
2 otherlibs/labltk/browser/viewer.ml
@@ -239,7 +239,7 @@ let view_defined ~env ?(show_all=false) modlid =
in
let l = iter_sign sign [] in
let title = string_of_path path in
- let env = open_signature path sign env in
+ let env = open_signature Asttypes.Fresh path sign env in
!choose_symbol_ref l ~title ~signature:sign ~env ~path;
if show_all then view_signature sign ~title ~env ~path
| _ -> ()
View
12 parsing/ast_mapper.ml
@@ -173,7 +173,7 @@ module MT = struct
let module_ ?loc a b = mk_item ?loc (Psig_module (a, b))
let rec_module ?loc a = mk_item ?loc (Psig_recmodule a)
let modtype ?loc a b = mk_item ?loc (Psig_modtype (a, b))
- let open_ ?loc a = mk_item ?loc (Psig_open a)
+ let open_ ?loc a b = mk_item ?loc (Psig_open (a, b))
let include_ ?loc a = mk_item ?loc (Psig_include a)
let class_ ?loc a = mk_item ?loc (Psig_class a)
let class_type ?loc a = mk_item ?loc (Psig_class_type a)
@@ -188,7 +188,7 @@ module MT = struct
| Psig_recmodule l -> rec_module ~loc (List.map (map_tuple (map_loc sub) (sub # module_type)) l)
| Psig_modtype (s, Pmodtype_manifest mt) -> modtype ~loc (map_loc sub s) (Pmodtype_manifest (sub # module_type mt))
| Psig_modtype (s, Pmodtype_abstract) -> modtype ~loc (map_loc sub s) Pmodtype_abstract
- | Psig_open s -> open_ ~loc (map_loc sub s)
+ | Psig_open (ovf, s) -> open_ ~loc ovf (map_loc sub s)
| Psig_include mt -> include_ ~loc (sub # module_type mt)
| Psig_class l -> class_ ~loc (List.map (sub # class_description) l)
| Psig_class_type l -> class_type ~loc (List.map (sub # class_type_declaration) l)
@@ -227,7 +227,7 @@ module M = struct
let module_ ?loc a b = mk_item ?loc (Pstr_module (a, b))
let rec_module ?loc a = mk_item ?loc (Pstr_recmodule a)
let modtype ?loc a b = mk_item ?loc (Pstr_modtype (a, b))
- let open_ ?loc a = mk_item ?loc (Pstr_open a)
+ let open_ ?loc a b = mk_item ?loc (Pstr_open (a, b))
let class_ ?loc a = mk_item ?loc (Pstr_class a)
let class_type ?loc a = mk_item ?loc (Pstr_class_type a)
let include_ ?loc a = mk_item ?loc (Pstr_include a)
@@ -244,7 +244,7 @@ module M = struct
| Pstr_module (s, m) -> module_ ~loc (map_loc sub s) (sub # module_expr m)
| Pstr_recmodule l -> rec_module ~loc (List.map (fun (s, mty, me) -> (map_loc sub s, sub # module_type mty, sub # module_expr me)) l)
| Pstr_modtype (s, mty) -> modtype ~loc (map_loc sub s) (sub # module_type mty)
- | Pstr_open lid -> open_ ~loc (map_loc sub lid)
+ | Pstr_open (ovf, lid) -> open_ ~loc ovf (map_loc sub lid)
| Pstr_class l -> class_ ~loc (List.map (sub # class_declaration) l)
| Pstr_class_type l -> class_type ~loc (List.map (sub # class_type_declaration) l)
| Pstr_include e -> include_ ~loc (sub # module_expr e)
@@ -287,7 +287,7 @@ module E = struct
let object_ ?loc a = mk ?loc (Pexp_object a)
let newtype ?loc a b = mk ?loc (Pexp_newtype (a, b))
let pack ?loc a = mk ?loc (Pexp_pack a)
- let open_ ?loc a b = mk ?loc (Pexp_open (a, b))
+ let open_ ?loc a b c = mk ?loc (Pexp_open (a, b, c))
let lid ?(loc = Location.none) lid = ident ~loc (mkloc (Longident.parse lid) loc)
let apply_nolabs ?loc f el = apply ?loc f (List.map (fun e -> ("", e)) el)
@@ -328,7 +328,7 @@ module E = struct
| Pexp_object cls -> object_ ~loc (sub # class_structure cls)
| Pexp_newtype (s, e) -> newtype ~loc s (sub # expr e)
| Pexp_pack me -> pack ~loc (sub # module_expr me)
- | Pexp_open (lid, e) -> open_ ~loc (map_loc sub lid) (sub # expr e)
+ | Pexp_open (ovf, lid, e) -> open_ ~loc ovf (map_loc sub lid) (sub # expr e)
end
module P = struct
View
6 parsing/ast_mapper.mli
@@ -145,7 +145,7 @@ module MT:
val module_: ?loc:Location.t -> string loc -> module_type -> signature_item
val rec_module: ?loc:Location.t -> (string loc * module_type) list -> signature_item
val modtype: ?loc:Location.t -> string loc -> modtype_declaration -> signature_item
- val open_: ?loc:Location.t -> Longident.t loc -> signature_item
+ val open_: ?loc:Location.t -> override_flag -> Longident.t loc -> signature_item
val include_: ?loc:Location.t -> module_type -> signature_item
val class_: ?loc:Location.t -> class_description list -> signature_item
val class_type: ?loc:Location.t -> class_type_declaration list -> signature_item
@@ -172,7 +172,7 @@ module M:
val module_: ?loc:Location.t -> string loc -> module_expr -> structure_item
val rec_module: ?loc:Location.t -> (string loc * module_type * module_expr) list -> structure_item
val modtype: ?loc:Location.t -> string loc -> module_type -> structure_item
- val open_: ?loc:Location.t -> Longident.t loc -> structure_item
+ val open_: ?loc:Location.t -> override_flag -> Longident.t loc -> structure_item
val class_: ?loc:Location.t -> class_declaration list -> structure_item
val class_type: ?loc:Location.t -> class_type_declaration list -> structure_item
val include_: ?loc:Location.t -> module_expr -> structure_item
@@ -214,7 +214,7 @@ module E:
val object_: ?loc:Location.t -> class_structure -> expression
val newtype: ?loc:Location.t -> string -> expression -> expression
val pack: ?loc:Location.t -> module_expr -> expression
- val open_: ?loc:Location.t -> Longident.t loc -> expression -> expression
+ val open_: ?loc:Location.t -> override_flag -> Longident.t loc -> expression -> expression
val lid: ?loc:Location.t -> string -> expression
val apply_nolabs: ?loc:Location.t -> expression -> expression list -> expression
val strconst: ?loc:Location.t -> string -> expression
View
14 parsing/parser.mly
@@ -594,8 +594,8 @@ structure_item:
{ mkstr(Pstr_recmodule(List.rev $3)) }
| MODULE TYPE ident EQUAL module_type
{ mkstr(Pstr_modtype(mkrhs $3 3, $5)) }
- | OPEN mod_longident
- { mkstr(Pstr_open (mkrhs $2 2)) }
+ | OPEN override_flag mod_longident
+ { mkstr(Pstr_open ($2, mkrhs $3 3)) }
| CLASS class_declarations
{ mkstr(Pstr_class (List.rev $2)) }
| CLASS TYPE class_type_declarations
@@ -664,8 +664,8 @@ signature_item:
{ mksig(Psig_modtype(mkrhs $3 3, Pmodtype_abstract)) }
| MODULE TYPE ident EQUAL module_type
{ mksig(Psig_modtype(mkrhs $3 3, Pmodtype_manifest $5)) }
- | OPEN mod_longident
- { mksig(Psig_open (mkrhs $2 2)) }
+ | OPEN override_flag mod_longident
+ { mksig(Psig_open ($2, mkrhs $3 3)) }
| INCLUDE module_type
{ mksig(Psig_include $2) }
| CLASS class_descriptions
@@ -970,8 +970,8 @@ expr:
{ mkexp(Pexp_let($2, List.rev $3, $5)) }
| LET MODULE UIDENT module_binding IN seq_expr
{ mkexp(Pexp_letmodule(mkrhs $3 3, $4, $6)) }
- | LET OPEN mod_longident IN seq_expr
- { mkexp(Pexp_open(mkrhs $3 3, $5)) }
+ | LET OPEN override_flag mod_longident IN seq_expr
+ { mkexp(Pexp_open($3, mkrhs $4 4, $6)) }
| FUNCTION opt_bar match_cases
{ mkexp(Pexp_function("", None, List.rev $3)) }
| FUN labeled_simple_pattern fun_def
@@ -1088,7 +1088,7 @@ simple_expr:
| simple_expr DOT label_longident
{ mkexp(Pexp_field($1, mkrhs $3 3)) }
| mod_longident DOT LPAREN seq_expr RPAREN
- { mkexp(Pexp_open(mkrhs $1 1, $4)) }
+ { mkexp(Pexp_open(Fresh, mkrhs $1 1, $4)) }
| mod_longident DOT LPAREN seq_expr error
{ unclosed "(" 3 ")" 5 }
| simple_expr DOT LPAREN seq_expr RPAREN
View
6 parsing/parsetree.mli
@@ -118,7 +118,7 @@ and expression_desc =
| Pexp_object of class_structure
| Pexp_newtype of string * expression
| Pexp_pack of module_expr
- | Pexp_open of Longident.t loc * expression
+ | Pexp_open of override_flag * Longident.t loc * expression
(* Value descriptions *)
@@ -242,7 +242,7 @@ and signature_item_desc =
| Psig_module of string loc * module_type
| Psig_recmodule of (string loc * module_type) list
| Psig_modtype of string loc * modtype_declaration
- | Psig_open of Longident.t loc
+ | Psig_open of override_flag * Longident.t loc
| Psig_include of module_type
| Psig_class of class_description list
| Psig_class_type of class_type_declaration list
@@ -287,7 +287,7 @@ and structure_item_desc =
| Pstr_module of string loc * module_expr
| Pstr_recmodule of (string loc * module_type * module_expr) list
| Pstr_modtype of string loc * module_type
- | Pstr_open of Longident.t loc
+ | Pstr_open of override_flag * Longident.t loc
| Pstr_class of class_declaration list
| Pstr_class_type of class_type_declaration list
| Pstr_include of module_expr
View
12 parsing/pprintast.ml
@@ -612,8 +612,8 @@ class printer ()= object(self:'self)
pp f "@[<hov2>lazy@ %a@]" self#simple_expr e
| Pexp_poly _ ->
assert false
- | Pexp_open (lid, e) ->
- pp f "@[<2>let open %a in@;%a@]" self#longident_loc lid
+ | Pexp_open (ovf, lid, e) ->
+ pp f "@[<2>let open%s %a in@;%a@]" (override ovf) self#longident_loc lid
self#expression e
| Pexp_variant (l,Some eo) ->
pp f "@[<2>`%s@;%a@]" l self#simple_expr eo
@@ -881,8 +881,8 @@ class printer ()= object(self:'self)
pp f "@[<hov>module@ %s@ :@ %a@]"
s.txt
self#module_type mt
- | Psig_open li ->
- pp f "@[<hov2>open@ %a@]" self#longident_loc li
+ | Psig_open (ovf, li) ->
+ pp f "@[<hov2>open%s@ %a@]" (override ovf) self#longident_loc li
| Psig_include (mt) ->
pp f "@[<hov2>include@ %a@]"
self#module_type mt
@@ -1017,8 +1017,8 @@ class printer ()= object(self:'self)
| _ ->
pp f " =@ %a" self#module_expr me
)) me
- | Pstr_open (li) ->
- pp f "@[<2>open@;%a@]" self#longident_loc li;
+ | Pstr_open (ovf, li) ->
+ pp f "@[<2>open%s@;%a@]" (override ovf) self#longident_loc li;
| Pstr_modtype (s, mt) ->
pp f "@[<2>module type %s =@;%a@]" s.txt self#module_type mt
| Pstr_class l ->
View
15 parsing/printast.ml
@@ -334,8 +334,9 @@ and expression i ppf x =
| Pexp_pack me ->
line i ppf "Pexp_pack\n";
module_expr i ppf me
- | Pexp_open (m, e) ->
- line i ppf "Pexp_open \"%a\"\n" fmt_longident_loc m;
+ | Pexp_open (ovf, m, e) ->
+ line i ppf "Pexp_open %a \"%a\"\n" fmt_override_flag ovf
+ fmt_longident_loc m;
expression i ppf e
and value_description i ppf x =
@@ -558,7 +559,10 @@ and signature_item i ppf x =
| Psig_modtype (s, md) ->
line i ppf "Psig_modtype %a\n" fmt_string_loc s;
modtype_declaration i ppf md;
- | Psig_open li -> line i ppf "Psig_open %a\n" fmt_longident_loc li;
+ | Psig_open (ovf, li) ->
+ line i ppf "Psig_open %a %a\n"
+ fmt_override_flag ovf
+ fmt_longident_loc li;
| Psig_include (mt) ->
line i ppf "Psig_include\n";
module_type i ppf mt;
@@ -645,7 +649,10 @@ and structure_item i ppf x =
| Pstr_modtype (s, mt) ->
line i ppf "Pstr_modtype %a\n" fmt_string_loc s;
module_type i ppf mt;
- | Pstr_open li -> line i ppf "Pstr_open %a\n" fmt_longident_loc li;
+ | Pstr_open (ovf, li) ->
+ line i ppf "Pstr_open %a %a\n"
+ fmt_override_flag ovf
+ fmt_longident_loc li;
| Pstr_class (l) ->
line i ppf "Pstr_class\n";
list i class_declaration ppf l;
View
6 tools/depend.ml
@@ -174,7 +174,7 @@ let rec add_expr bv exp =
let bv = add_pattern bv pat in 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
+ | Pexp_open (_ovf, m, e) -> addmodule bv m; add_expr bv e
and add_pat_expr_list bv pel =
List.iter (fun (p, e) -> let bv = add_pattern bv p in add_expr bv e) pel
@@ -225,7 +225,7 @@ and add_sig_item bv item =
| Pmodtype_manifest mty -> add_modtype bv mty
end;
bv
- | Psig_open lid ->
+ | Psig_open (_ovf, lid) ->
addmodule bv lid; bv
| Psig_include mty ->
add_modtype bv mty; bv
@@ -277,7 +277,7 @@ and add_struct_item bv item =
bv'
| Pstr_modtype(id, mty) ->
add_modtype bv mty; bv
- | Pstr_open l ->
+ | Pstr_open (_ovf, l) ->
addmodule bv l; bv
| Pstr_class cdl ->
List.iter (add_class_declaration bv) cdl; bv
View
2 tools/ocamlprof.ml
@@ -281,7 +281,7 @@ and rw_exp iflag sexp =
List.iter (rewrite_class_field iflag) cl.pcstr_fields
| Pexp_newtype (_, sexp) -> rewrite_exp iflag sexp
- | Pexp_open (_, e) -> rewrite_exp iflag e
+ | Pexp_open (_ovf, _, e) -> rewrite_exp iflag e
| Pexp_pack (smod) -> rewrite_mod iflag smod
and rewrite_ifbody iflag ghost sifbody =
View
6 tools/untypeast.ml
@@ -64,7 +64,7 @@ and untype_structure_item item =
untype_module_expr mexpr) list)
| Tstr_modtype (_id, name, mtype) ->
Pstr_modtype (name, untype_module_type mtype)
- | Tstr_open (_path, lid) -> Pstr_open (lid)
+ | Tstr_open (ovf, _path, lid) -> Pstr_open (ovf, lid)
| Tstr_class list ->
Pstr_class (List.map (fun (ci, _, _) ->
{ pci_virt = ci.ci_virt;
@@ -182,7 +182,7 @@ and untype_extra (extra, loc) sexp =
Pexp_constraint (sexp,
option untype_core_type cty1,
option untype_core_type cty2)
- | Texp_open (_path, lid, _) -> Pexp_open (lid, sexp)
+ | Texp_open (ovf, _path, lid, _) -> Pexp_open (ovf, lid, sexp)
| Texp_poly cto -> Pexp_poly (sexp, option untype_core_type cto)
| Texp_newtype s -> Pexp_newtype (s, sexp)
in
@@ -317,7 +317,7 @@ and untype_signature_item item =
name, untype_module_type mtype) list)
| Tsig_modtype (_id, name, mdecl) ->
Psig_modtype (name, untype_modtype_declaration mdecl)
- | Tsig_open (_path, lid) -> Psig_open (lid)
+ | Tsig_open (ovf, _path, lid) -> Psig_open (ovf, lid)
| Tsig_include (mty, _lid) -> Psig_include (untype_module_type mty)
| Tsig_class list ->
Psig_class (List.map untype_class_description list)
View
4 typing/cmt_format.ml
@@ -75,8 +75,8 @@ module ClearEnv = TypedtreeMap.MakeMap (struct
let leave_pattern p = { p with pat_env = keep_only_summary p.pat_env }
let leave_expression e =
let exp_extra = List.map (function
- (Texp_open (path, lloc, env), loc) ->
- (Texp_open (path, lloc, keep_only_summary env), loc)
+ (Texp_open (ovf, path, lloc, env), loc) ->
+ (Texp_open (ovf, path, lloc, keep_only_summary env), loc)
| exp_extra -> exp_extra) e.exp_extra in
{ e with
exp_env = keep_only_summary e.exp_env;
View
4 typing/env.ml
@@ -1367,8 +1367,8 @@ let open_pers_signature name env =
let ps = find_pers_struct name in
open_signature None (Pident(Ident.create_persistent name)) ps.ps_sig env
-let open_signature ?(loc = Location.none) ?(toplevel = false) root sg env =
- if not toplevel && not loc.Location.loc_ghost && (Warnings.is_active (Warnings.Unused_open "") || Warnings.is_active (Warnings.Open_shadow_identifier ("", "")))
+let open_signature ?(loc = Location.none) ?(toplevel = false) ovf root sg env =
+ if not toplevel && ovf = Asttypes.Fresh && not loc.Location.loc_ghost && (Warnings.is_active (Warnings.Unused_open "") || Warnings.is_active (Warnings.Open_shadow_identifier ("", "")))
then begin
let used = ref false in
!add_delayed_check_forward
View
2 typing/env.mli
@@ -106,7 +106,7 @@ val add_signature: signature -> t -> t
(* Insertion of all fields of a signature, relative to the given path.
Used to implement open. *)
-val open_signature: ?loc:Location.t -> ?toplevel:bool -> Path.t -> signature -> t -> t
+val open_signature: ?loc:Location.t -> ?toplevel:bool -> Asttypes.override_flag -> Path.t -> signature -> t -> t
val open_pers_signature: string -> t -> t
(* Insertion by name *)
View
2 typing/envaux.ml
@@ -63,7 +63,7 @@ let rec env_from_summary sum subst =
with Not_found ->
raise (Error (Module_not_found path'))
in
- Env.open_signature path' (extract_sig env mty) env
+ Env.open_signature Asttypes.Override path' (extract_sig env mty) env
in
Hashtbl.add env_cache (sum, subst) env;
env
View
10 typing/printtyped.ml
@@ -234,8 +234,8 @@ and expression_extra i ppf x =
line i ppf "Pexp_constraint\n";
option i core_type ppf cto1;
option i core_type ppf cto2;
- | Texp_open (m, _, _) ->
- line i ppf "Pexp_open \"%a\"\n" fmt_path m;
+ | Texp_open (ovf, m, _, _) ->
+ line i ppf "Pexp_open %a \"%a\"\n" fmt_override_flag ovf fmt_path m;
| Texp_poly cto ->
line i ppf "Pexp_poly\n";
option i core_type ppf cto;
@@ -579,7 +579,8 @@ and signature_item i ppf x =
| Tsig_modtype (s, _, md) ->
line i ppf "Psig_modtype \"%a\"\n" fmt_ident s;
modtype_declaration i ppf md;
- | Tsig_open (li,_) -> line i ppf "Psig_open %a\n" fmt_path li;
+ | Tsig_open (ovf, li,_) ->
+ line i ppf "Psig_open %a %a\n" fmt_override_flag ovf fmt_path li;
| Tsig_include (mt, _) ->
line i ppf "Psig_include\n";
module_type i ppf mt;
@@ -668,7 +669,8 @@ and structure_item i ppf x =
| Tstr_modtype (s, _, mt) ->
line i ppf "Pstr_modtype \"%a\"\n" fmt_ident s;
module_type i ppf mt;
- | Tstr_open (li, _) -> line i ppf "Pstr_open %a\n" fmt_path li;
+ | Tstr_open (ovf, li, _) ->
+ line i ppf "Pstr_open %a %a\n" fmt_override_flag ovf fmt_path li;
| Tstr_class (l) ->
line i ppf "Pstr_class\n";
list i class_declaration ppf (List.map (fun (cl, _,_) -> cl) l);
View
11 typing/typecore.ml
@@ -131,7 +131,7 @@ let iter_expression f e =
| Pexp_variant (_, eo) -> may expr eo
| Pexp_record (iel, eo) ->
may expr eo; List.iter (fun (_, e) -> expr e) iel
- | Pexp_open (_, e)
+ | Pexp_open (_, _, e)
| Pexp_newtype (_, e)
| Pexp_poly (e, _)
| Pexp_lazy e
@@ -2699,11 +2699,12 @@ and type_expect_ ?in_function env sexp ty_expected =
exp_loc = loc; exp_extra = [];
exp_type = newty (Tpackage (p, nl, tl'));
exp_env = env }
- | Pexp_open (lid, e) ->
- let (path, newenv) = !type_open env sexp.pexp_loc lid in
+ | Pexp_open (ovf, lid, e) ->
+ let (path, newenv) = !type_open ovf env sexp.pexp_loc lid in
let exp = type_expect newenv e ty_expected in
{ exp with
- exp_extra = (Texp_open (path, lid, newenv), loc) :: exp.exp_extra;
+ exp_extra = (Texp_open (ovf, path, lid, newenv), loc) ::
+ exp.exp_extra;
}
and type_label_access env loc srecord lid =
@@ -2785,7 +2786,7 @@ and type_argument env sarg ty_expected' ty_expected =
let rec is_inferred sexp =
match sexp.pexp_desc with
Pexp_ident _ | Pexp_apply _ | Pexp_send _ | Pexp_field _ -> true
- | Pexp_open (_, e) -> is_inferred e
+ | Pexp_open (_, _, e) -> is_inferred e
| _ -> false
in
match expand_head env ty_expected' with
View
2 typing/typecore.mli
@@ -113,7 +113,7 @@ val report_error: Env.t -> 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 loc -> Path.t * Env.t) ref
+val type_open: (override_flag -> Env.t -> Location.t -> Longident.t loc -> Path.t * Env.t) ref
(* Forward declaration, to be filled in by Typeclass.class_structure *)
val type_object:
(Env.t -> Location.t -> Parsetree.class_structure ->
View
6 typing/typedtree.ml
@@ -58,7 +58,7 @@ and expression =
and exp_extra =
| Texp_constraint of core_type option * core_type option
- | Texp_open of Path.t * Longident.t loc * Env.t
+ | Texp_open of override_flag * Path.t * Longident.t loc * Env.t
| Texp_poly of core_type option
| Texp_newtype of string
@@ -199,7 +199,7 @@ and structure_item_desc =
| Tstr_module of Ident.t * string loc * module_expr
| Tstr_recmodule of (Ident.t * string loc * module_type * module_expr) list
| Tstr_modtype of Ident.t * string loc * module_type
- | Tstr_open of Path.t * Longident.t loc
+ | Tstr_open of override_flag * Path.t * Longident.t loc
| Tstr_class of (class_declaration * string list * virtual_flag) list
| Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
| Tstr_include of module_expr * Ident.t list
@@ -241,7 +241,7 @@ and signature_item_desc =
| Tsig_module of Ident.t * string loc * module_type
| Tsig_recmodule of (Ident.t * string loc * module_type) list
| Tsig_modtype of Ident.t * string loc * modtype_declaration
- | Tsig_open of Path.t * Longident.t loc
+ | Tsig_open of override_flag * Path.t * Longident.t loc
| Tsig_include of module_type * Types.signature
| Tsig_class of class_description list
| Tsig_class_type of class_type_declaration list
View
6 typing/typedtree.mli
@@ -57,7 +57,7 @@ and expression =
and exp_extra =
| Texp_constraint of core_type option * core_type option
- | Texp_open of Path.t * Longident.t loc * Env.t
+ | Texp_open of override_flag * Path.t * Longident.t loc * Env.t
| Texp_poly of core_type option
| Texp_newtype of string
@@ -198,7 +198,7 @@ and structure_item_desc =
| Tstr_module of Ident.t * string loc * module_expr
| Tstr_recmodule of (Ident.t * string loc * module_type * module_expr) list
| Tstr_modtype of Ident.t * string loc * module_type
- | Tstr_open of Path.t * Longident.t loc
+ | Tstr_open of override_flag * Path.t * Longident.t loc
| Tstr_class of (class_declaration * string list * virtual_flag) list
| Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
| Tstr_include of module_expr * Ident.t list
@@ -240,7 +240,7 @@ and signature_item_desc =
| Tsig_module of Ident.t * string loc * module_type
| Tsig_recmodule of (Ident.t * string loc * module_type) list
| Tsig_modtype of Ident.t * string loc * modtype_declaration
- | Tsig_open of Path.t * Longident.t loc
+ | Tsig_open of override_flag * Path.t * Longident.t loc
| Tsig_include of module_type * Types.signature
| Tsig_class of class_description list
| Tsig_class_type of class_type_declaration list
View
2 typing/typedtreeIter.ml
@@ -229,7 +229,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
match cstr with
Texp_constraint (cty1, cty2) ->
option iter_core_type cty1; option iter_core_type cty2
- | Texp_open (path, _, _) -> ()
+ | Texp_open (_, path, _, _) -> ()
| Texp_poly cto -> option iter_core_type cto
| Texp_newtype s -> ())
exp.exp_extra;
View
4 typing/typedtreeMap.ml
@@ -121,7 +121,7 @@ module MakeMap(Map : MapArgument) = struct
Tstr_recmodule list
| Tstr_modtype (id, name, mtype) ->
Tstr_modtype (id, name, map_module_type mtype)
- | Tstr_open (path, lid) -> Tstr_open (path, lid)
+ | Tstr_open (ovf, path, lid) -> Tstr_open (ovf, path, lid)
| Tstr_class list ->
let list =
List.map (fun (ci, string_list, virtual_flag) ->
@@ -401,7 +401,7 @@ module MakeMap(Map : MapArgument) = struct
(id, name, map_module_type mtype) ) list)
| Tsig_modtype (id, name, mdecl) ->
Tsig_modtype (id, name, map_modtype_declaration mdecl)
- | Tsig_open (path, lid) -> item.sig_desc
+ | Tsig_open _ -> item.sig_desc
| Tsig_include (mty, lid) -> Tsig_include (map_module_type mty, lid)
| Tsig_class list -> Tsig_class (List.map map_class_description list)
| Tsig_class_type list ->
View
21 typing/typemod.ml
@@ -64,10 +64,10 @@ let extract_sig_open env loc mty =
(* Compute the environment after opening a module *)
-let type_open ?toplevel env loc lid =
+let type_open ?toplevel ovf env loc lid =
let (path, mty) = Typetexp.find_module env loc lid.txt in
let sg = extract_sig_open env loc mty in
- path, Env.open_signature ~loc ?toplevel path sg env
+ path, Env.open_signature ~loc ?toplevel ovf path sg env
(* Record a module type *)
let rm node =
@@ -315,8 +315,8 @@ and approx_sig env ssg =
let info = approx_modtype_info env sinfo in
let (id, newenv) = Env.enter_modtype name.txt info env in
Sig_modtype(id, info) :: approx_sig newenv srem
- | Psig_open lid ->
- let (path, mty) = type_open env item.psig_loc lid in
+ | Psig_open (ovf, lid) ->
+ let (path, mty) = type_open ovf env item.psig_loc lid in
approx_sig mty srem
| Psig_include smty ->
let mty = approx_modtype env smty in
@@ -514,10 +514,11 @@ and transl_signature env sg =
mksig (Tsig_modtype (id, name, tinfo)) env loc :: trem,
Sig_modtype(id, info) :: rem,
final_env
- | Psig_open lid ->
- let (path, newenv) = type_open env item.psig_loc lid in
+ | Psig_open (ovf, lid) ->
+ let (path, newenv) = type_open ovf env item.psig_loc lid in
let (trem, rem, final_env) = transl_sig newenv srem in
- mksig (Tsig_open (path,lid)) env loc :: trem, rem, final_env
+ mksig (Tsig_open (ovf, path,lid)) env loc :: trem,
+ rem, final_env
| Psig_include smty ->
let tmty = transl_modtype env smty in
let mty = tmty.mty_type in
@@ -1065,9 +1066,9 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
(item :: str_rem,
Sig_modtype(id, Modtype_manifest mty.mty_type) :: sig_rem,
final_env)
- | Pstr_open (lid) ->
- let (path, newenv) = type_open ~toplevel env loc lid in
- let item = mk (Tstr_open (path, lid)) in
+ | Pstr_open (ovf, lid) ->
+ let (path, newenv) = type_open ovf ~toplevel env loc lid in
+ let item = mk (Tstr_open (ovf, path, lid)) in
let (str_rem, sig_rem, final_env) = type_struct newenv srem in
(item :: str_rem, sig_rem, final_env)
| Pstr_class cl ->

0 comments on commit a3b1c67

Please sign in to comment.
Something went wrong with that request. Please try again.