commit
1fb6a464a8
3
Changes
3
Changes
|
@ -695,6 +695,9 @@ OCaml 4.11
|
|||
even if they are at tail position.
|
||||
(Jacques-Henri Jourdan, review by Gabriel Scherer)
|
||||
|
||||
- #9244: Fix some missing usage warnings
|
||||
(Leo White, review by Florian Angeletti)
|
||||
|
||||
- #9274, avoid reading cmi file while printing types
|
||||
(Florian Angeletti, review by Gabriel Scherer)
|
||||
|
||||
|
|
|
@ -68,7 +68,7 @@ let typecheck_intf info ast =
|
|||
Format.(fprintf std_formatter) "%a@."
|
||||
(Printtyp.printed_signature info.source_file)
|
||||
sg);
|
||||
ignore (Includemod.signatures info.env sg sg);
|
||||
ignore (Includemod.signatures info.env ~mark:Mark_both sg sg);
|
||||
Typecore.force_delayed_checks ();
|
||||
Warnings.check_fatal ();
|
||||
tsg
|
||||
|
|
|
@ -0,0 +1,55 @@
|
|||
(* TEST
|
||||
flags = " -w A "
|
||||
* expect
|
||||
*)
|
||||
|
||||
module type U = sig end
|
||||
[%%expect {|
|
||||
module type U = sig end
|
||||
|}]
|
||||
|
||||
module M : sig
|
||||
module F2 (_ : U) : U
|
||||
end = struct
|
||||
module X = struct
|
||||
let x = 13
|
||||
end
|
||||
|
||||
module F1 (_ : U) = X
|
||||
module F2 (M : U) = F1 (M)
|
||||
end
|
||||
[%%expect {|
|
||||
Line 5, characters 8-9:
|
||||
5 | let x = 13
|
||||
^
|
||||
Warning 32: unused value x.
|
||||
module M : sig module F2 : U -> U end
|
||||
|}]
|
||||
|
||||
module N : sig
|
||||
module F2 (_ : U) : U
|
||||
end = struct
|
||||
module X = struct
|
||||
let x = 13
|
||||
end
|
||||
|
||||
module F1 (_ : U) = X
|
||||
module F2 (_ : U) = F1 (struct end)
|
||||
end
|
||||
[%%expect {|
|
||||
Line 5, characters 8-9:
|
||||
5 | let x = 13
|
||||
^
|
||||
Warning 32: unused value x.
|
||||
module N : sig module F2 : U -> U end
|
||||
|}]
|
||||
|
||||
|
||||
module F (X : sig type t type s end) = struct type t = X.t end
|
||||
[%%expect {|
|
||||
Line 1, characters 25-31:
|
||||
1 | module F (X : sig type t type s end) = struct type t = X.t end
|
||||
^^^^^^
|
||||
Warning 34: unused type s.
|
||||
module F : functor (X : sig type t type s end) -> sig type t = X.t end
|
||||
|}]
|
|
@ -335,8 +335,7 @@ let execute_phrase print_outcome ppf phr =
|
|||
let (str, sg, names, newenv) = Typemod.type_toplevel_phrase oldenv sstr in
|
||||
if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
|
||||
let sg' = Typemod.Signature_names.simplify newenv names sg in
|
||||
(* Why is this done? *)
|
||||
ignore (Includemod.signatures oldenv sg sg');
|
||||
ignore (Includemod.signatures oldenv ~mark:Mark_positive sg sg');
|
||||
Typecore.force_delayed_checks ();
|
||||
let module_ident, res, required_globals, size =
|
||||
if Config.flambda then
|
||||
|
|
|
@ -275,7 +275,7 @@ let execute_phrase print_outcome ppf phr =
|
|||
let (str, sg, sn, newenv) = Typemod.type_toplevel_phrase oldenv sstr in
|
||||
if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
|
||||
let sg' = Typemod.Signature_names.simplify newenv sn sg in
|
||||
ignore (Includemod.signatures oldenv sg sg');
|
||||
ignore (Includemod.signatures ~mark:Mark_positive oldenv sg sg');
|
||||
Typecore.force_delayed_checks ();
|
||||
let lam = Translmod.transl_toplevel_definition str in
|
||||
Warnings.check_fatal ();
|
||||
|
|
|
@ -582,7 +582,7 @@ let () =
|
|||
(* Check that an implementation of a compilation unit meets its
|
||||
interface. *)
|
||||
|
||||
let compunit env ?(mark=Mark_both) impl_name impl_sig intf_name intf_sig =
|
||||
let compunit env ~mark impl_name impl_sig intf_name intf_sig =
|
||||
try
|
||||
signatures ~loc:(Location.in_file impl_name) env ~mark []
|
||||
Subst.identity impl_sig intf_sig
|
||||
|
@ -592,13 +592,13 @@ let compunit env ?(mark=Mark_both) impl_name impl_sig intf_name intf_sig =
|
|||
|
||||
(* Hide the context and substitution parameters to the outside world *)
|
||||
|
||||
let modtypes ~loc env ?(mark=Mark_both) mty1 mty2 =
|
||||
let modtypes ~loc env ~mark mty1 mty2 =
|
||||
modtypes ~loc env ~mark [] Subst.identity mty1 mty2
|
||||
let signatures env ?(mark=Mark_both) sig1 sig2 =
|
||||
let signatures env ~mark sig1 sig2 =
|
||||
signatures ~loc:Location.none env ~mark [] Subst.identity sig1 sig2
|
||||
let type_declarations ~loc env ?(mark=Mark_both) id decl1 decl2 =
|
||||
let type_declarations ~loc env ~mark id decl1 decl2 =
|
||||
type_declarations ~loc env ~mark [] Subst.identity id decl1 decl2
|
||||
let strengthened_module_decl ~loc ~aliasable env ?(mark=Mark_both)
|
||||
let strengthened_module_decl ~loc ~aliasable env ~mark
|
||||
md1 path1 md2 =
|
||||
strengthened_module_decl ~loc ~aliasable env ~mark [] Subst.identity
|
||||
md1 path1 md2
|
||||
|
|
|
@ -32,11 +32,11 @@ type mark =
|
|||
(** Do not mark definitions used from either argument *)
|
||||
|
||||
val modtypes:
|
||||
loc:Location.t -> Env.t -> ?mark:mark ->
|
||||
loc:Location.t -> Env.t -> mark:mark ->
|
||||
module_type -> module_type -> module_coercion
|
||||
|
||||
val strengthened_module_decl:
|
||||
loc:Location.t -> aliasable:bool -> Env.t -> ?mark:mark ->
|
||||
loc:Location.t -> aliasable:bool -> Env.t -> mark:mark ->
|
||||
module_declaration -> Path.t -> module_declaration -> module_coercion
|
||||
|
||||
val check_modtype_inclusion :
|
||||
|
@ -46,15 +46,15 @@ val check_modtype_inclusion :
|
|||
functor application F(M) is well typed, where mty2 is the type of
|
||||
the argument of F and path1/mty1 is the path/unstrenghened type of M. *)
|
||||
|
||||
val signatures: Env.t -> ?mark:mark ->
|
||||
val signatures: Env.t -> mark:mark ->
|
||||
signature -> signature -> module_coercion
|
||||
|
||||
val compunit:
|
||||
Env.t -> ?mark:mark -> string -> signature ->
|
||||
Env.t -> mark:mark -> string -> signature ->
|
||||
string -> signature -> module_coercion
|
||||
|
||||
val type_declarations:
|
||||
loc:Location.t -> Env.t -> ?mark:mark ->
|
||||
loc:Location.t -> Env.t -> mark:mark ->
|
||||
Ident.t -> type_declaration -> type_declaration -> unit
|
||||
|
||||
val print_coercion: formatter -> module_coercion -> unit
|
||||
|
|
|
@ -249,7 +249,7 @@ let check_type_decl env loc id row_id newdecl decl rs rem =
|
|||
| Some id -> Env.add_type ~check:false id newdecl env
|
||||
in
|
||||
let env = if rs = Trec_not then env else add_rec_types env rem in
|
||||
Includemod.type_declarations ~loc env id newdecl decl;
|
||||
Includemod.type_declarations ~mark:Mark_both ~loc env id newdecl decl;
|
||||
Typedecl.check_coherence env loc (Path.Pident id) newdecl
|
||||
|
||||
let update_rec_next rs rem =
|
||||
|
@ -539,7 +539,8 @@ let merge_constraint initial_env remove_aliases loc sg constr =
|
|||
let mty = Mtype.scrape_for_type_of ~remove_aliases sig_env mty in
|
||||
let md'' = { md' with md_type = mty } in
|
||||
let newmd = Mtype.strengthen_decl ~aliasable:false sig_env md'' path in
|
||||
ignore(Includemod.modtypes ~loc sig_env newmd.md_type md.md_type);
|
||||
ignore(Includemod.modtypes ~mark:Mark_both ~loc sig_env
|
||||
newmd.md_type md.md_type);
|
||||
(Pident id, lid, Twith_module (path, lid')),
|
||||
Sig_module(id, pres, newmd, rs, priv) :: rem
|
||||
| (Sig_module(id, _, md, rs, _) :: rem, [s], Pwith_modsubst (_, lid'))
|
||||
|
@ -547,8 +548,8 @@ let merge_constraint initial_env remove_aliases loc sg constr =
|
|||
let path, md' = Env.lookup_module ~loc lid'.txt initial_env in
|
||||
let aliasable = not (Env.is_functor_arg path sig_env) in
|
||||
ignore
|
||||
(Includemod.strengthened_module_decl ~loc ~aliasable sig_env
|
||||
md' path md);
|
||||
(Includemod.strengthened_module_decl ~loc ~mark:Mark_both
|
||||
~aliasable sig_env md' path md);
|
||||
real_ids := [Pident id];
|
||||
(Pident id, lid, Twith_modsubst (path, lid')),
|
||||
update_rec_next rs rem
|
||||
|
@ -1766,7 +1767,8 @@ let check_recmodule_inclusion env bindings =
|
|||
and mty_actual' = subst_and_strengthen env scope s id mty_actual in
|
||||
let coercion =
|
||||
try
|
||||
Includemod.modtypes ~loc:modl.mod_loc env mty_actual' mty_decl'
|
||||
Includemod.modtypes ~loc:modl.mod_loc ~mark:Mark_both env
|
||||
mty_actual' mty_decl'
|
||||
with Includemod.Error msg ->
|
||||
raise(Error(modl.mod_loc, env, Not_included msg)) in
|
||||
let modl' =
|
||||
|
@ -1842,9 +1844,10 @@ let package_subtype env p1 nl1 tl1 p2 nl2 tl2 =
|
|||
modtype_of_package env Location.none p nl tl
|
||||
in
|
||||
let mty1 = mkmty p1 nl1 tl1 and mty2 = mkmty p2 nl2 tl2 in
|
||||
try Includemod.modtypes ~loc:Location.none env mty1 mty2 = Tcoerce_none
|
||||
with Includemod.Error _msg -> false
|
||||
(* raise(Error(Location.none, env, Not_included msg)) *)
|
||||
let loc = Location.none in
|
||||
match Includemod.modtypes ~loc ~mark:Mark_both env mty1 mty2 with
|
||||
| Tcoerce_none -> true
|
||||
| _ | exception Includemod.Error _ -> false
|
||||
|
||||
let () = Ctype.package_subtype := package_subtype
|
||||
|
||||
|
@ -1965,7 +1968,8 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
|
|||
| Mty_functor (Named (param, mty_param), mty_res) as mty_functor ->
|
||||
let coercion =
|
||||
try
|
||||
Includemod.modtypes ~loc:sarg.pmod_loc env arg.mod_type mty_param
|
||||
Includemod.modtypes ~loc:sarg.pmod_loc ~mark:Mark_both env
|
||||
arg.mod_type mty_param
|
||||
with Includemod.Error msg ->
|
||||
raise(Error(sarg.pmod_loc, env, Not_included msg)) in
|
||||
let mty_appl =
|
||||
|
@ -1995,7 +1999,8 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
|
|||
Cannot_eliminate_dependency mty_functor))
|
||||
in
|
||||
begin match
|
||||
Includemod.modtypes ~loc:smod.pmod_loc env mty_res nondep_mty
|
||||
Includemod.modtypes ~mark:Mark_neither
|
||||
~loc:smod.pmod_loc env mty_res nondep_mty
|
||||
with
|
||||
| Tcoerce_none -> ()
|
||||
| _ ->
|
||||
|
@ -2655,7 +2660,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
|
|||
Interface_not_compiled sourceintf)) in
|
||||
let dclsig = Env.read_signature modulename intf_file in
|
||||
let coercion =
|
||||
Includemod.compunit initial_env ~mark:Includemod.Mark_positive
|
||||
Includemod.compunit initial_env ~mark:Mark_positive
|
||||
sourcefile sg intf_file dclsig
|
||||
in
|
||||
Typecore.force_delayed_checks ();
|
||||
|
@ -2669,7 +2674,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
|
|||
(str, coercion)
|
||||
end else begin
|
||||
let coercion =
|
||||
Includemod.compunit initial_env ~mark:Includemod.Mark_positive
|
||||
Includemod.compunit initial_env ~mark:Mark_positive
|
||||
sourcefile sg "(inferred signature)" simple_sg
|
||||
in
|
||||
check_nongen_schemes finalenv simple_sg;
|
||||
|
@ -2772,7 +2777,8 @@ let package_units initial_env objfiles cmifile modulename =
|
|||
let dclsig = Env.read_signature modulename cmifile in
|
||||
Cmt_format.save_cmt (prefix ^ ".cmt") modulename
|
||||
(Cmt_format.Packed (sg, objfiles)) None initial_env None ;
|
||||
Includemod.compunit initial_env "(obtained by packing)" sg mlifile dclsig
|
||||
Includemod.compunit initial_env ~mark:Mark_both
|
||||
"(obtained by packing)" sg mlifile dclsig
|
||||
end else begin
|
||||
(* Determine imports *)
|
||||
let unit_names = List.map fst units in
|
||||
|
|
Loading…
Reference in New Issue