diff options
| author |  letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2011-01-27 00:39:56 +0000 |
|---|---|---|
| committer | letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2011-01-27 00:39:56 +0000 |
| commit | b95e86482ffef29ee4a74c0ef6e7ac2d604d9d3e (patch) | |
| tree | cb27ab1fcb0234c7ba1ecf3ea7295b018e950a16 /pretyping/tacred.ml | |
| parent | bc2cebecc14bee4a1a486ff0bead87b6fd69d452 (diff) | |
Make simpl use the proper constant when folding (mutual) fixpoints
Before this commit, when simpl was finding the constant name
for folding some (mutual) fixpoint, this was done via some
repr_con followed by make_con. Problem: this doesn't preserve
the canonical part of a Names.constant. For instance the following
script was buggish:
Module M.
Fixpoint foo n := match n with O => O | S n => bar n end
with bar n := match n with O => O | S n => foo n end.
End M.
Module N.
Include M. (* foo, bar have here "user name" N but "canonical name" M *)
Eval simpl in (fun x => bar (S x)).
(* Anomaly: uncaught exception Failure "Cannot print a global reference". *)
(* since simpl has produce a different bar with both user and canonical N *)
TODO : check all other uses of make_con in the rest of the sources...
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13803 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping/tacred.ml')
| -rw-r--r-- | pretyping/tacred.ml | 7 |
1 files changed, 3 insertions, 4 deletions
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml index 99776367b..de87e5029 100644 --- a/pretyping/tacred.ml +++ b/pretyping/tacred.ml @@ -214,8 +214,7 @@ let invert_name labs l na0 env sigma ref = function | EvalRel _ | EvalEvar _ -> None | EvalVar id' -> Some (EvalVar id) | EvalConst kn -> - let (mp,dp,_) = repr_con kn in - Some (EvalConst (make_con mp dp (label_of_id id))) in + Some (EvalConst (con_with_label kn (label_of_id id))) in match refi with | None -> None | Some ref -> @@ -468,7 +467,6 @@ let reduce_mind_case_use_function func env sigma mia = | CoFix (bodynum,(names,_,_) as cofix) -> let build_cofix_name = if isConst func then - let (mp,dp,_) = repr_con (destConst func) in let minargs = List.length mia.mcargs in fun i -> if i = bodynum then Some (minargs,func) @@ -479,7 +477,8 @@ let reduce_mind_case_use_function func env sigma mia = mutual inductive, try to reuse the global name if the block was indeed initially built as a global definition *) - let kn = make_con mp dp (label_of_id id) in + let kn = con_with_label (destConst func) (label_of_id id) + in try match constant_opt_value env kn with | None -> None (* TODO: check kn is correct *) |