Skip to content
Browse files

* split Typetexp.lookup_module and Typetexp.find_module

* fix semantics of -open by using Typemod.type_open_


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14795 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
1 parent 68ae2cc commit 77cf8b999eeec9f9f7787aab82886155dee89c98 Jacques Garrigue committed May 12, 2014
Showing with 97 additions and 98 deletions.
  1. +4 −4 driver/compmisc.ml
  2. +2 −0 driver/main_args.ml
  3. +47 −39 ocamldoc/.depend
  4. +1 −2 toplevel/topdirs.ml
  5. +15 −25 typing/env.ml
  6. +1 −1 typing/env.mli
  7. +8 −12 typing/typemod.ml
  8. +3 −0 typing/typemod.mli
  9. +14 −15 typing/typetexp.ml
  10. +2 −0 typing/typetexp.mli
View
8 driver/compmisc.ml
@@ -40,10 +40,10 @@ let init_path native =
toplevel initialization (PR#1775) *)
let open_implicit_module m env =
- try
- Env.open_pers_signature m env
- with Not_found ->
- Misc.fatal_error (Printf.sprintf "cannot open implicit module %S" m)
+ let open Asttypes in
+ let lid = {loc = Location.in_file "command line";
+ txt = Longident.Lident m } in
+ snd (Typemod.type_open_ Override env lid.loc lid)
let initial_env () =
Ident.reinit();
View
2 driver/main_args.ml
@@ -685,6 +685,7 @@ struct
mk_noprompt F._noprompt;
mk_nopromptcont F._nopromptcont;
mk_nostdlib F._nostdlib;
+ mk_open F._open;
mk_ppx F._ppx;
mk_principal F._principal;
mk_rectypes F._rectypes;
@@ -811,6 +812,7 @@ module Make_opttop_options (F : Opttop_options) = struct
mk_noprompt F._noprompt;
mk_nopromptcont F._nopromptcont;
mk_nostdlib F._nostdlib;
+ mk_open F._open;
mk_ppx F._ppx;
mk_principal F._principal;
mk_rectypes F._rectypes;
View
86 ocamldoc/.depend
@@ -32,16 +32,16 @@ odoc_ast.cmo : ../typing/types.cmi ../typing/typedtree.cmi \
../typing/predef.cmi ../typing/path.cmi ../parsing/parsetree.cmi \
odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_sig.cmi \
odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \
- odoc_global.cmi odoc_exception.cmo odoc_env.cmi odoc_class.cmo \
- ../utils/misc.cmi ../parsing/location.cmi ../typing/ident.cmi \
- ../parsing/asttypes.cmi odoc_ast.cmi
+ odoc_global.cmi odoc_extension.cmo odoc_exception.cmo odoc_env.cmi \
+ odoc_class.cmo ../utils/misc.cmi ../parsing/location.cmi \
+ ../typing/ident.cmi ../parsing/asttypes.cmi odoc_ast.cmi
odoc_ast.cmx : ../typing/types.cmx ../typing/typedtree.cmx \
../typing/predef.cmx ../typing/path.cmx ../parsing/parsetree.cmi \
odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_sig.cmx \
odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_messages.cmx \
- odoc_global.cmx odoc_exception.cmx odoc_env.cmx odoc_class.cmx \
- ../utils/misc.cmx ../parsing/location.cmx ../typing/ident.cmx \
- ../parsing/asttypes.cmi odoc_ast.cmi
+ odoc_global.cmx odoc_extension.cmx odoc_exception.cmx odoc_env.cmx \
+ odoc_class.cmx ../utils/misc.cmx ../parsing/location.cmx \
+ ../typing/ident.cmx ../parsing/asttypes.cmi odoc_ast.cmi
odoc_class.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \
odoc_parameter.cmo odoc_name.cmi
odoc_class.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \
@@ -62,12 +62,12 @@ odoc_control.cmo :
odoc_control.cmx :
odoc_cross.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_search.cmi \
odoc_scan.cmo odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \
- odoc_misc.cmi odoc_messages.cmo odoc_global.cmi odoc_exception.cmo \
- odoc_class.cmo odoc_cross.cmi
+ odoc_misc.cmi odoc_messages.cmo odoc_global.cmi odoc_extension.cmo \
+ odoc_exception.cmo odoc_class.cmo odoc_cross.cmi
odoc_cross.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_search.cmx \
odoc_scan.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \
- odoc_misc.cmx odoc_messages.cmx odoc_global.cmx odoc_exception.cmx \
- odoc_class.cmx odoc_cross.cmi
+ odoc_misc.cmx odoc_messages.cmx odoc_global.cmx odoc_extension.cmx \
+ odoc_exception.cmx odoc_class.cmx odoc_cross.cmi
odoc_dag2html.cmo : odoc_info.cmi odoc_dag2html.cmi
odoc_dag2html.cmx : odoc_info.cmx odoc_dag2html.cmi
odoc_dep.cmo : ../parsing/parsetree.cmi odoc_type.cmo odoc_print.cmi \
@@ -84,6 +84,10 @@ odoc_env.cmx : ../typing/types.cmx ../typing/printtyp.cmx \
../typing/btype.cmx odoc_env.cmi
odoc_exception.cmo : ../typing/types.cmi odoc_types.cmi odoc_name.cmi
odoc_exception.cmx : ../typing/types.cmx odoc_types.cmx odoc_name.cmx
+odoc_extension.cmo : ../typing/types.cmi odoc_types.cmi odoc_name.cmi \
+ ../parsing/asttypes.cmi
+odoc_extension.cmx : ../typing/types.cmx odoc_types.cmx odoc_name.cmx \
+ ../parsing/asttypes.cmi
odoc_gen.cmo : odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \
odoc_html.cmo odoc_dot.cmo odoc_gen.cmi
odoc_gen.cmx : odoc_texi.cmx odoc_module.cmx odoc_man.cmx odoc_latex.cmx \
@@ -99,15 +103,15 @@ odoc_html.cmx : odoc_text.cmx odoc_ocamlhtml.cmx odoc_messages.cmx \
odoc_info.cmo : ../typing/printtyp.cmi odoc_value.cmo odoc_types.cmi \
odoc_type.cmo odoc_text.cmi odoc_str.cmi odoc_search.cmi odoc_scan.cmo \
odoc_print.cmi odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \
- odoc_misc.cmi odoc_global.cmi odoc_exception.cmo odoc_dep.cmo \
- odoc_config.cmi odoc_comments.cmi odoc_class.cmo odoc_analyse.cmi \
- ../parsing/location.cmi odoc_info.cmi
+ odoc_misc.cmi odoc_global.cmi odoc_extension.cmo odoc_exception.cmo \
+ odoc_dep.cmo odoc_config.cmi odoc_comments.cmi odoc_class.cmo \
+ odoc_analyse.cmi ../parsing/location.cmi odoc_info.cmi
odoc_info.cmx : ../typing/printtyp.cmx odoc_value.cmx odoc_types.cmx \
odoc_type.cmx odoc_text.cmx odoc_str.cmx odoc_search.cmx odoc_scan.cmx \
odoc_print.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \
- odoc_misc.cmx odoc_global.cmx odoc_exception.cmx odoc_dep.cmx \
- odoc_config.cmx odoc_comments.cmx odoc_class.cmx odoc_analyse.cmx \
- ../parsing/location.cmx odoc_info.cmi
+ odoc_misc.cmx odoc_global.cmx odoc_extension.cmx odoc_exception.cmx \
+ odoc_dep.cmx odoc_config.cmx odoc_comments.cmx odoc_class.cmx \
+ odoc_analyse.cmx ../parsing/location.cmx odoc_info.cmi
odoc_inherit.cmo :
odoc_inherit.cmx :
odoc_latex.cmo : odoc_to_text.cmo odoc_messages.cmo odoc_latex_style.cmo \
@@ -126,10 +130,12 @@ odoc_man.cmx : odoc_str.cmx odoc_print.cmx odoc_misc.cmx odoc_messages.cmx \
odoc_info.cmx ../utils/misc.cmx ../parsing/asttypes.cmi
odoc_merge.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo \
odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \
- odoc_global.cmi odoc_exception.cmo odoc_class.cmo odoc_merge.cmi
+ odoc_global.cmi odoc_extension.cmo odoc_exception.cmo odoc_class.cmo \
+ odoc_merge.cmi
odoc_merge.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx \
odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_messages.cmx \
- odoc_global.cmx odoc_exception.cmx odoc_class.cmx odoc_merge.cmi
+ odoc_global.cmx odoc_extension.cmx odoc_exception.cmx odoc_class.cmx \
+ odoc_merge.cmi
odoc_messages.cmo : ../utils/config.cmi
odoc_messages.cmx : ../utils/config.cmx
odoc_misc.cmo : ../typing/types.cmi ../typing/predef.cmi ../typing/path.cmi \
@@ -139,9 +145,11 @@ odoc_misc.cmx : ../typing/types.cmx ../typing/predef.cmx ../typing/path.cmx \
odoc_types.cmx odoc_messages.cmx ../parsing/longident.cmx \
../typing/ctype.cmx ../typing/btype.cmx odoc_misc.cmi
odoc_module.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \
- odoc_type.cmo odoc_name.cmi odoc_exception.cmo odoc_class.cmo
+ odoc_type.cmo odoc_name.cmi odoc_extension.cmo odoc_exception.cmo \
+ odoc_class.cmo
odoc_module.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \
- odoc_type.cmx odoc_name.cmx odoc_exception.cmx odoc_class.cmx
+ odoc_type.cmx odoc_name.cmx odoc_extension.cmx odoc_exception.cmx \
+ odoc_class.cmx
odoc_name.cmo : ../typing/path.cmi odoc_misc.cmi ../typing/ident.cmi \
odoc_name.cmi
odoc_name.cmx : ../typing/path.cmx odoc_misc.cmx ../typing/ident.cmx \
@@ -157,38 +165,38 @@ odoc_print.cmo : ../typing/types.cmi ../typing/printtyp.cmi \
odoc_print.cmx : ../typing/types.cmx ../typing/printtyp.cmx \
../utils/misc.cmx odoc_print.cmi
odoc_scan.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \
- odoc_exception.cmo odoc_class.cmo
+ odoc_extension.cmo odoc_exception.cmo odoc_class.cmo
odoc_scan.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_module.cmx \
- odoc_exception.cmx odoc_class.cmx
+ odoc_extension.cmx odoc_exception.cmx odoc_class.cmx
odoc_search.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo \
- odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_exception.cmo \
- odoc_class.cmo odoc_search.cmi
+ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_extension.cmo \
+ odoc_exception.cmo odoc_class.cmo odoc_search.cmi
odoc_search.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx \
- odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_exception.cmx \
- odoc_class.cmx odoc_search.cmi
+ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_extension.cmx \
+ odoc_exception.cmx odoc_class.cmx odoc_search.cmi
odoc_see_lexer.cmo : odoc_parser.cmi
odoc_see_lexer.cmx : odoc_parser.cmx
odoc_sig.cmo : ../typing/types.cmi ../typing/typedtree.cmi \
../typing/path.cmi ../parsing/parsetree.cmi odoc_value.cmo odoc_types.cmi \
odoc_type.cmo odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \
odoc_misc.cmi odoc_messages.cmo odoc_merge.cmi odoc_global.cmi \
- odoc_exception.cmo odoc_env.cmi odoc_class.cmo ../utils/misc.cmi \
- ../parsing/location.cmi ../typing/ident.cmi ../typing/btype.cmi \
- ../parsing/asttypes.cmi odoc_sig.cmi
+ odoc_extension.cmo odoc_exception.cmo odoc_env.cmi odoc_class.cmo \
+ ../utils/misc.cmi ../parsing/location.cmi ../typing/ident.cmi \
+ ../typing/btype.cmi ../parsing/asttypes.cmi odoc_sig.cmi
odoc_sig.cmx : ../typing/types.cmx ../typing/typedtree.cmx \
../typing/path.cmx ../parsing/parsetree.cmi odoc_value.cmx odoc_types.cmx \
odoc_type.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \
odoc_misc.cmx odoc_messages.cmx odoc_merge.cmx odoc_global.cmx \
- odoc_exception.cmx odoc_env.cmx odoc_class.cmx ../utils/misc.cmx \
- ../parsing/location.cmx ../typing/ident.cmx ../typing/btype.cmx \
- ../parsing/asttypes.cmi odoc_sig.cmi
+ odoc_extension.cmx odoc_exception.cmx odoc_env.cmx odoc_class.cmx \
+ ../utils/misc.cmx ../parsing/location.cmx ../typing/ident.cmx \
+ ../typing/btype.cmx ../parsing/asttypes.cmi odoc_sig.cmi
odoc_str.cmo : ../typing/types.cmi ../typing/printtyp.cmi odoc_value.cmo \
odoc_type.cmo odoc_print.cmi odoc_name.cmi odoc_misc.cmi \
- odoc_messages.cmo odoc_exception.cmo odoc_class.cmo \
+ odoc_messages.cmo odoc_extension.cmo odoc_exception.cmo odoc_class.cmo \
../parsing/asttypes.cmi odoc_str.cmi
odoc_str.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_value.cmx \
odoc_type.cmx odoc_print.cmx odoc_name.cmx odoc_misc.cmx \
- odoc_messages.cmx odoc_exception.cmx odoc_class.cmx \
+ odoc_messages.cmx odoc_extension.cmx odoc_exception.cmx odoc_class.cmx \
../parsing/asttypes.cmi odoc_str.cmi
odoc_test.cmo : odoc_info.cmi odoc_gen.cmi odoc_args.cmi
odoc_test.cmx : odoc_info.cmx odoc_gen.cmx odoc_args.cmx
@@ -219,8 +227,7 @@ odoc_value.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_types.cmx \
odoc_analyse.cmi : odoc_module.cmo odoc_global.cmi
odoc_args.cmi : odoc_gen.cmi
odoc_ast.cmi : ../typing/types.cmi ../typing/typedtree.cmi \
- ../typing/path.cmi ../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi \
- odoc_module.cmo
+ ../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi odoc_module.cmo
odoc_comments.cmi : odoc_types.cmi odoc_module.cmo
odoc_comments_global.cmi :
odoc_config.cmi :
@@ -232,19 +239,20 @@ odoc_gen.cmi : odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \
odoc_global.cmi : odoc_types.cmi
odoc_info.cmi : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \
odoc_type.cmo odoc_search.cmi odoc_parameter.cmo odoc_module.cmo \
- odoc_global.cmi odoc_exception.cmo odoc_class.cmo ../parsing/location.cmi
+ odoc_global.cmi odoc_extension.cmo odoc_exception.cmo odoc_class.cmo \
+ ../parsing/location.cmi
odoc_merge.cmi : odoc_types.cmi odoc_module.cmo
odoc_misc.cmi : ../typing/types.cmi odoc_types.cmi ../parsing/longident.cmi
odoc_name.cmi : ../typing/path.cmi ../parsing/longident.cmi \
../typing/ident.cmi
odoc_parser.cmi : odoc_types.cmi
odoc_print.cmi : ../typing/types.cmi
odoc_search.cmi : odoc_value.cmo odoc_types.cmi odoc_type.cmo \
- odoc_module.cmo odoc_exception.cmo odoc_class.cmo
+ odoc_module.cmo odoc_extension.cmo odoc_exception.cmo odoc_class.cmo
odoc_sig.cmi : ../typing/types.cmi ../parsing/parsetree.cmi odoc_types.cmi \
odoc_type.cmo odoc_name.cmi odoc_module.cmo odoc_env.cmi odoc_class.cmo
odoc_str.cmi : ../typing/types.cmi odoc_value.cmo odoc_type.cmo \
- odoc_exception.cmo odoc_class.cmo
+ odoc_extension.cmo odoc_exception.cmo odoc_class.cmo
odoc_text.cmi : odoc_types.cmi
odoc_text_parser.cmi : odoc_types.cmi
odoc_types.cmi : ../parsing/location.cmi
View
3 toplevel/topdirs.ml
@@ -410,8 +410,7 @@ let () =
let () =
reg_show_prim "show_module"
(fun env loc id lid ->
- let path = Typetexp.find_module env loc lid in
- let md = Env.find_module path env in
+ let path, md = Typetexp.find_module env loc lid in
[ Sig_module (id, {md with md_type = trim_signature md.md_type},
Trec_not) ]
)
View
40 typing/env.ml
@@ -288,8 +288,7 @@ type pers_struct =
ps_comps: module_components;
ps_crcs: (string * Digest.t option) list;
ps_filename: string;
- ps_flags: pers_flags list;
- mutable ps_crcs_checked: bool }
+ ps_flags: pers_flags list }
let persistent_structures =
(Hashtbl.create 17 : (string, pers_struct option) Hashtbl.t)
@@ -309,15 +308,13 @@ let add_imports ps =
ps.ps_crcs
let check_consistency ps =
- if ps.ps_crcs_checked then () else
try
List.iter
(fun (name, crco) ->
match crco with
None -> ()
| Some crc -> Consistbl.check crc_units name crc ps.ps_filename)
- ps.ps_crcs;
- ps.ps_crcs_checked <- true
+ ps.ps_crcs
with Consistbl.Inconsistency(name, source, auth) ->
error (Inconsistent_import(name, auth, source))
@@ -338,13 +335,12 @@ let read_pers_struct modname filename =
ps_sig = sign;
ps_comps = comps;
ps_crcs = crcs;
- ps_crcs_checked = false;
ps_filename = filename;
ps_flags = flags } in
if ps.ps_name <> modname then
error (Illegal_renaming(modname, ps.ps_name, filename));
add_imports ps;
- if not !Clflags.transparent_modules then check_consistency ps;
+ check_consistency ps;
List.iter
(function Rectypes ->
if not !Clflags.recursive_types then
@@ -353,27 +349,23 @@ let read_pers_struct modname filename =
Hashtbl.add persistent_structures modname (Some ps);
ps
-let find_pers_struct ?(check=true) name =
+let find_pers_struct name =
if name = "*predef*" then raise Not_found;
let r =
try Some (Hashtbl.find persistent_structures name)
with Not_found -> None
in
- let ps =
- match r with
- | Some None -> raise Not_found
- | Some (Some sg) -> sg
- | None ->
+ match r with
+ | Some None -> raise Not_found
+ | Some (Some sg) -> sg
+ | None ->
let filename =
try find_in_path_uncap !load_path (name ^ ".cmi")
with Not_found ->
Hashtbl.add persistent_structures name None;
raise Not_found
in
read_pers_struct name filename
- in
- if check then check_consistency ps;
- ps
let reset_cache () =
current_unit := "";
@@ -629,7 +621,7 @@ let rec lookup_module_descr lid env =
end
| Lapply(l1, l2) ->
let (p1, desc1) = lookup_module_descr l1 env in
- let p2 = lookup_module l2 env in
+ let p2 = lookup_module true l2 env in
let {md_type=mty2} = find_module p2 env in
begin match EnvLazy.force !components_of_module_maker' desc1 with
Functor_comps f ->
@@ -639,7 +631,7 @@ let rec lookup_module_descr lid env =
raise Not_found
end
-and lookup_module lid env : Path.t =
+and lookup_module ~load lid env : Path.t =
match lid with
Lident s ->
begin try
@@ -653,11 +645,11 @@ and lookup_module lid env : Path.t =
p
with Not_found ->
if s = !current_unit then raise Not_found;
- if !Clflags.transparent_modules then
+ if !Clflags.transparent_modules && not load then
try ignore (find_in_path_uncap !load_path (s ^ ".cmi"))
with Not_found ->
Location.prerr_warning Location.none (Warnings.No_cmi_file s)
- else ignore (find_pers_struct ~check:false s);
+ else ignore (find_pers_struct s);
Pident(Ident.create_persistent s)
end
| Ldot(l, s) ->
@@ -671,7 +663,7 @@ and lookup_module lid env : Path.t =
end
| Lapply(l1, l2) ->
let (p1, desc1) = lookup_module_descr l1 env in
- let p2 = lookup_module l2 env in
+ let p2 = lookup_module true l2 env in
let {md_type=mty2} = find_module p2 env in
let p = Papply(p1, p2) in
begin match EnvLazy.force !components_of_module_maker' desc1 with
@@ -1571,13 +1563,12 @@ let open_signature ?(loc = Location.none) ?(toplevel = false) ovf root sg env =
let read_signature modname filename =
let ps = read_pers_struct modname filename in
- check_consistency ps;
ps.ps_sig
(* Return the CRC of the interface of the given compilation unit *)
let crc_of_unit name =
- let ps = find_pers_struct ~check:false name in
+ let ps = find_pers_struct name in
let crco =
try
List.assoc name ps.ps_crcs
@@ -1622,8 +1613,7 @@ let save_signature_with_imports sg modname filename imports =
ps_comps = comps;
ps_crcs = (cmi.cmi_name, Some crc) :: imports;
ps_filename = filename;
- ps_flags = cmi.cmi_flags;
- ps_crcs_checked = true } in
+ ps_flags = cmi.cmi_flags } in
Hashtbl.add persistent_structures modname (Some ps);
Consistbl.set crc_units modname crc filename;
imported_units := modname :: !imported_units;
View
2 typing/env.mli
@@ -87,7 +87,7 @@ val lookup_label: Longident.t -> t -> label_description
val lookup_all_labels:
Longident.t -> t -> (label_description * (unit -> unit)) list
val lookup_type: Longident.t -> t -> Path.t * type_declaration
-val lookup_module: Longident.t -> t -> Path.t
+val lookup_module: load:bool -> Longident.t -> t -> Path.t
val lookup_modtype: Longident.t -> t -> Path.t * modtype_declaration
val lookup_class: Longident.t -> t -> Path.t * class_declaration
val lookup_cltype: Longident.t -> t -> Path.t * class_type_declaration
View
20 typing/typemod.ml
@@ -68,8 +68,7 @@ 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.find_module env lid.loc lid.txt in
- let md = Env.find_module path env in
+ let path, md = Typetexp.find_module env lid.loc lid.txt in
let sg = extract_sig_open env lid.loc md.md_type in
path, Env.open_signature ~loc ?toplevel ovf path sg env
@@ -211,17 +210,15 @@ let merge_constraint initial_env loc sg constr =
make_next_first rs rem
| (Sig_module(id, md, rs) :: rem, [s], Pwith_module (_, lid))
when Ident.name id = s ->
- let path = Typetexp.find_module initial_env loc lid.txt in
- let md' = Env.find_module path env in
+ let path, md' = Typetexp.find_module initial_env loc lid.txt in
let md'' = {md' with md_type = Mtype.remove_aliases env md'.md_type} in
let newmd = Mtype.strengthen_decl env md'' path in
ignore(Includemod.modtypes env newmd.md_type md.md_type);
(Pident id, lid, Twith_module (path, lid)),
Sig_module(id, newmd, rs) :: rem
| (Sig_module(id, md, rs) :: rem, [s], Pwith_modsubst (_, lid))
when Ident.name id = s ->
- let path = Typetexp.find_module initial_env loc lid.txt in
- let md' = Env.find_module path env in
+ let path, md' = Typetexp.find_module initial_env loc lid.txt in
let newmd = Mtype.strengthen_decl env md' path in
ignore(Includemod.modtypes env newmd.md_type md.md_type);
real_id := Some id;
@@ -269,7 +266,7 @@ let merge_constraint initial_env loc sg constr =
| [s], Pwith_modsubst (_, lid) ->
let id =
match !real_id with None -> assert false | Some id -> id in
- let path = Typetexp.find_module initial_env loc lid.txt in
+ let path = Typetexp.lookup_module initial_env loc lid.txt in
let sub = Subst.add_module id path Subst.identity in
Subst.signature sub sg
| _ ->
@@ -320,7 +317,7 @@ let rec approx_modtype env smty =
let (path, info) = Typetexp.find_modtype env smty.pmty_loc lid.txt in
Mty_ident path
| Pmty_alias lid ->
- let path = Typetexp.find_module env smty.pmty_loc lid.txt in
+ let path = Typetexp.lookup_module env smty.pmty_loc lid.txt in
Mty_alias path
| Pmty_signature ssg ->
Mty_signature(approx_sig env ssg)
@@ -473,7 +470,7 @@ let transl_modtype_longident loc env lid =
path
let transl_module_alias loc env lid =
- Typetexp.find_module env loc lid
+ Typetexp.lookup_module env loc lid
let mkmty desc typ env loc attrs =
let mty = {
@@ -1029,7 +1026,7 @@ let wrap_constraint env arg mty explicit =
let rec type_module ?(alias=false) sttn funct_body anchor env smod =
match smod.pmod_desc with
Pmod_ident lid ->
- let path = Typetexp.find_module env smod.pmod_loc lid.txt in
+ let path = Typetexp.lookup_module env smod.pmod_loc lid.txt in
let md = { mod_desc = Tmod_ident (path, lid);
mod_type = Mty_alias path;
mod_env = env;
@@ -1477,8 +1474,7 @@ let type_module_type_of env smod =
let tmty =
match smod.pmod_desc with
| Pmod_ident lid -> (* turn off strengthening in this case *)
- let path = Typetexp.find_module env smod.pmod_loc lid.txt in
- let md = Env.find_module path env in
+ let path, md = Typetexp.find_module env smod.pmod_loc lid.txt in
rm { mod_desc = Tmod_ident (path, lid);
mod_type = md.md_type;
mod_env = env;
View
3 typing/typemod.mli
@@ -32,6 +32,9 @@ val transl_signature:
Env.t -> Parsetree.signature -> Typedtree.signature
val check_nongen_schemes:
Env.t -> Typedtree.structure_item list -> unit
+val type_open_:
+ ?toplevel:bool -> Asttypes.override_flag ->
+ Env.t -> Location.t -> Longident.t Asttypes.loc -> Path.t * Env.t
val simplify_signature: signature -> signature
View
29 typing/typetexp.ml
@@ -175,24 +175,17 @@ let instance_list = Ctype.instance_list Env.empty
let rec narrow_unbound_lid_error : 'a. _ -> _ -> _ -> _ -> 'a =
fun env loc lid make_error ->
let check_module mlid =
- let old = !Clflags.transparent_modules in
- Clflags.transparent_modules := false;
- try
- ignore (Env.lookup_module mlid env);
- Clflags.transparent_modules := old
- with
+ try ignore (Env.lookup_module true mlid env) with
| Not_found ->
- Clflags.transparent_modules := old;
- narrow_unbound_lid_error env loc mlid
- (fun lid -> Unbound_module lid)
+ narrow_unbound_lid_error env loc mlid (fun lid -> Unbound_module lid)
| Env.Recmodule ->
raise (Error (loc, env, Illegal_reference_to_recursive_module))
in
begin match lid with
| Longident.Lident _ -> ()
| Longident.Ldot (mlid, _) ->
check_module mlid;
- let md = Env.find_module (Env.lookup_module mlid env) env in
+ let md = Env.find_module (Env.lookup_module true mlid env) env in
begin match Env.scrape_alias env md.md_type with
Mty_functor _ ->
raise (Error (loc, env, Access_functor_as_structure mlid))
@@ -248,13 +241,19 @@ let find_value env loc lid =
check_deprecated loc decl.val_attributes (Path.name path);
r
-let find_module env loc lid =
+let lookup_module_ ~load env loc lid =
let (path, decl) as r =
- find_component (fun lid env -> (Env.lookup_module lid env, ()))
+ find_component (fun lid env -> (Env.lookup_module ~load lid env, ()))
(fun lid -> Unbound_module lid) env loc lid
- in
- (* check_deprecated loc decl.md_attributes (Path.name path); *)
- path
+ in path
+
+let find_module env loc lid =
+ let path = lookup_module_ true env loc lid in
+ let decl = Env.find_module path env in
+ check_deprecated loc decl.md_attributes (Path.name path);
+ (path, decl)
+
+let lookup_module = lookup_module_ ~load:false
let find_modtype env loc lid =
let (path, decl) as r =
View
2 typing/typetexp.mli
@@ -96,6 +96,8 @@ val find_value:
val find_class:
Env.t -> Location.t -> Longident.t -> Path.t * class_declaration
val find_module:
+ Env.t -> Location.t -> Longident.t -> Path.t * module_declaration
+val lookup_module:
Env.t -> Location.t -> Longident.t -> Path.t
val find_modtype:
Env.t -> Location.t -> Longident.t -> Path.t * modtype_declaration

0 comments on commit 77cf8b9

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