diff options
Diffstat (limited to 'kernel')
| -rw-r--r-- | kernel/mod_typing.ml | 4 | ||||
| -rw-r--r-- | kernel/modops.ml | 15 | ||||
| -rw-r--r-- | kernel/subtyping.ml | 2 |
3 files changed, 13 insertions, 8 deletions
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml index 4a2dd9afcd..83fc398e7e 100644 --- a/kernel/mod_typing.ml +++ b/kernel/mod_typing.ml @@ -164,7 +164,7 @@ and check_with_aux_mod env mtb with_decl now = in if now then let mp' = scrape_alias mp env' in - let up_subst = update_subst_alias mtb'.typ_alias (map_mp (mp_rec [id]) mp') in + let up_subst = update_subst mtb'.typ_alias (map_mp (mp_rec [id]) mp') in cst, (join (map_mp (mp_rec [id]) mp') up_subst) else cst,empty_subst @@ -186,7 +186,7 @@ and check_with_aux_mod env mtb with_decl now = if now then let mtb' = lookup_modtype mp env' in let mp' = scrape_alias mp env' in - let up_subst = update_subst_alias + let up_subst = update_subst mtb'.typ_alias (map_mp (mp_rec (List.rev (id::idl))) mp') in cst, (join (map_mp (mp_rec (List.rev (id::idl))) mp') up_subst) else diff --git a/kernel/modops.ml b/kernel/modops.ml index 49e49f5731..26030b9e94 100644 --- a/kernel/modops.ml +++ b/kernel/modops.ml @@ -168,8 +168,13 @@ and subst_module sub mb = (because the signature is "K with Module M := M'") and we are substituting M' with some M''. *) let me' = Option.smartmap (subst_struct_expr sub) mb.mod_expr in - let mb_alias = join_alias mb.mod_alias sub in - if mtb'==mb.mod_type && mb.mod_expr == me' + let mb_alias = update_subst sub mb.mod_alias in + let mb_alias = if mb_alias = empty_subst then + join_alias mb.mod_alias sub + else + join mb_alias (join_alias mb.mod_alias sub) + in + if mtb'==mb.mod_type && mb.mod_expr == me' && mb_alias == mb.mod_alias then mb else { mod_expr = me'; @@ -263,7 +268,7 @@ let rec eval_struct env = function (subst_key (map_msid msid mp) sub_alias) (map_msid msid mp) | _ -> sub_alias in - let sub_alias1 = update_subst_alias sub_alias + let sub_alias1 = update_subst sub_alias (map_mbid farg_id mp (None)) in let resolve = resolver_of_environment farg_id farg_b mp sub_alias env in eval_struct env (subst_struct_expr @@ -316,7 +321,7 @@ and merge_with env mtb with_decl alias= SFBconst c,None | With_module_body ([id], mp,cst) -> let mp' = scrape_alias mp env in - let new_alias = update_subst_alias alias (map_mp (mp_rec [id]) mp') in + let new_alias = update_subst alias (map_mp (mp_rec [id]) mp') in SFBalias (mp,Some cst), Some(join (map_mp (mp_rec [id]) mp') new_alias) | With_definition_body (_::_,_) @@ -335,7 +340,7 @@ and merge_with env mtb with_decl alias= in let subst = match subst1 with | None -> None - | Some s -> Some (join s (update_subst_alias alias s)) in + | Some s -> Some (join s (update_subst alias s)) in let modtype,subst_msb = merge_with env (type_of_mb env old) new_with_decl alias in let msb = diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml index 6354bb0fb6..918a2f51ba 100644 --- a/kernel/subtyping.ml +++ b/kernel/subtyping.ml @@ -331,7 +331,7 @@ and check_signatures cst env (msid1,sig1) alias (msid2,sig2') = let mp1 = MPself msid1 in let env = add_signature mp1 sig1 env in let sig1 = subst_structure alias sig1 in - let alias1 = update_subst_alias alias (map_msid msid2 mp1) in + let alias1 = update_subst alias (map_msid msid2 mp1) in let sig2 = subst_structure alias1 sig2' in let sig2 = subst_signature_msid msid2 mp1 sig2 in let map1 = make_label_map mp1 sig1 in |