diff options
| author | Xavier Leroy <xavier.leroy@inria.fr> | 2005-07-27 15:05:06 +0000 |
|---|---|---|
| committer | Xavier Leroy <xavier.leroy@inria.fr> | 2005-07-27 15:05:06 +0000 |
| commit | 0ebd045ef61940e770005bfe4e974ad326b61cf1 (patch) | |
| tree | bf3984b538fef90218d77ae1b822fca8dceb485f | |
| parent | 4792dbab6f32faa63bb5fe77d75b96f4fa94ff63 (diff) | |
| download | ocaml-0ebd045ef61940e770005bfe4e974ad326b61cf1.tar.gz | |
Penser a faire un strengthening lorsqu'on traite un chemin de la forme F(M).t
(PR#3738).
git-svn-id: http://caml.inria.fr/svn/ocaml/version/3.08@6984 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | typing/env.ml | 8 | ||||
| -rw-r--r-- | typing/env.mli | 3 | ||||
| -rw-r--r-- | typing/includemod.ml | 7 |
3 files changed, 10 insertions, 8 deletions
diff --git a/typing/env.ml b/typing/env.ml index f1b803658b..2707ff12da 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -112,8 +112,8 @@ let components_of_functor_appl' = functor_components -> Path.t -> Path.t -> module_components) let check_modtype_inclusion = (* to be filled with Includemod.check_modtype_inclusion *) - ref ((fun env mty1 mty2 -> assert false) : - t -> module_type -> module_type -> unit) + ref ((fun env mty1 path1 mty2 -> assert false) : + t -> module_type -> Path.t -> module_type -> unit) (* Persistent structure descriptions *) @@ -294,7 +294,7 @@ let rec lookup_module_descr lid env = let (p2, mty2) = lookup_module l2 env in begin match Lazy.force desc1 with Functor_comps f -> - !check_modtype_inclusion env mty2 f.fcomp_arg; + !check_modtype_inclusion env mty2 p2 f.fcomp_arg; (Papply(p1, p2), !components_of_functor_appl' f p1 p2) | Structure_comps c -> raise Not_found @@ -324,7 +324,7 @@ and lookup_module lid env = let p = Papply(p1, p2) in begin match Lazy.force desc1 with Functor_comps f -> - !check_modtype_inclusion env mty2 f.fcomp_arg; + !check_modtype_inclusion env mty2 p2 f.fcomp_arg; (p, Subst.modtype (Subst.add_module f.fcomp_param p2 f.fcomp_subst) f.fcomp_res) | Structure_comps c -> diff --git a/typing/env.mli b/typing/env.mli index aec0c29daf..3f88dfc5b8 100644 --- a/typing/env.mli +++ b/typing/env.mli @@ -135,5 +135,6 @@ open Format val report_error: formatter -> error -> unit (* Forward declaration to break mutual recursion with Includemod. *) -val check_modtype_inclusion: (t -> module_type -> module_type -> unit) ref +val check_modtype_inclusion: + (t -> module_type -> Path.t -> module_type -> unit) ref diff --git a/typing/includemod.ml b/typing/includemod.ml index 15a42d97d2..3d87200533 100644 --- a/typing/includemod.ml +++ b/typing/includemod.ml @@ -283,11 +283,12 @@ and check_modtype_equiv env mty1 mty2 = (Tcoerce_none, Tcoerce_none) -> () | (_, _) -> raise(Error [Modtype_permutation]) -(* Simplified inclusion check between module types *) +(* Simplified inclusion check between module types (for Env) *) -let check_modtype_inclusion env mty1 mty2 = +let check_modtype_inclusion env mty1 path1 mty2 = try - ignore(modtypes env Subst.identity mty1 mty2) + ignore(modtypes env Subst.identity + (Mtype.strengthen env mty1 path1) mty2) with Error reasons -> raise Not_found |