diff options
| author | soubiran | 2008-03-25 16:55:10 +0000 |
|---|---|---|
| committer | soubiran | 2008-03-25 16:55:10 +0000 |
| commit | 7dfb5d517e932b1b42445e4b1413dca72693cc4d (patch) | |
| tree | d3eff39598a905c31326ab82537b25a5e265b7ee /kernel/mod_typing.ml | |
| parent | 36780f223b50549f522ac2832eab127a9cc40615 (diff) | |
Correction de bugs relatifs a la compostion des substitutions
engendrees par les alias de module
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@10718 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'kernel/mod_typing.ml')
| -rw-r--r-- | kernel/mod_typing.ml | 16 |
1 files changed, 11 insertions, 5 deletions
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml index 3ae9293c73..36ef0c5e65 100644 --- a/kernel/mod_typing.ml +++ b/kernel/mod_typing.ml @@ -243,16 +243,22 @@ and translate_struct_entry env mse = match mse with let feb'= eval_struct env feb in let farg_id, farg_b, fbody_b = destr_functor env feb' in - let mtb = + let mtb,mp = try - lookup_modtype (path_of_mexpr mexpr) env + let mp = path_of_mexpr mexpr in + lookup_modtype mp env,mp with | Not_path -> error_application_to_not_path mexpr (* place for nondep_supertype *) in let meb,sub2= translate_struct_entry env mexpr in - let sub = join sub1 sub2 in - let sub = join_alias sub (map_mbid farg_id (path_of_mexpr mexpr) None) in - let sub = update_subst_alias sub (map_mbid farg_id (path_of_mexpr mexpr) None) in + let sub2 = match eval_struct env (SEBident mp) with + | SEBstruct (msid,sign) -> subst_key (map_msid msid mp) sub2 + | _ -> sub2 in + let sub3 = update_subst_alias sub2 (join_alias sub1 (map_mbid farg_id mp None)) in + let sub = if sub2 = sub3 then + join sub1 sub2 else join (join sub1 sub2) sub3 in + let sub = join_alias sub (map_mbid farg_id mp None) in + let sub = update_subst_alias sub (map_mbid farg_id mp None) in let cst = check_subtypes env mtb farg_b in SEBapply(feb,meb,cst),sub | MSEwith(mte, with_decl) -> |