diff options
| author | letouzey | 2013-03-21 19:50:03 +0000 |
|---|---|---|
| committer | letouzey | 2013-03-21 19:50:03 +0000 |
| commit | 4da7ddb8c3c2f1dafd5d9187741659a9332b75c2 (patch) | |
| tree | 7677e09e6e7f86b42a2accb668c27859defecd50 | |
| parent | d223f85d0fd57ce74dcdcc8690a36f1ef87b408d (diff) | |
Firstorder: record with defined field aren't conjonctions (fix #2629)
The let-in in the type of constructor was perturbating the
Hipattern.dependent check, leading firstorder to consider too much
inductives as dependent-free conjonctions, ending with lift errors
(UNBOUND_REL_-2, ouch).
This patch is probably overly cautious : if the variable of the
let-in is used, we consider the constructor to be dependent.
If someday somebody feels it necessary, he/she could try to reduce
the let-in's instead...
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16339 85f007b7-540e-0410-9357-904b9bb8a0f7
| -rw-r--r-- | tactics/hipattern.ml4 | 5 | ||||
| -rw-r--r-- | test-suite/bugs/closed/shouldsucceed/2629.v | 22 |
2 files changed, 26 insertions, 1 deletions
diff --git a/tactics/hipattern.ml4 b/tactics/hipattern.ml4 index 286aa94929..ede813cdba 100644 --- a/tactics/hipattern.ml4 +++ b/tactics/hipattern.ml4 @@ -58,9 +58,12 @@ let is_non_recursive_type t = op2bool (match_with_non_recursive_type t) (* Test dependencies *) +(* NB: we consider also the let-in case in the following function, + since they may appear in types of inductive constructors (see #2629) *) + let rec has_nodep_prod_after n c = match kind_of_term c with - | Prod (_,_,b) -> + | Prod (_,_,b) | LetIn (_,_,_,b) -> ( n>0 || not (dependent (mkRel 1) b)) && (has_nodep_prod_after (n-1) b) | _ -> true diff --git a/test-suite/bugs/closed/shouldsucceed/2629.v b/test-suite/bugs/closed/shouldsucceed/2629.v new file mode 100644 index 0000000000..759cd3dd28 --- /dev/null +++ b/test-suite/bugs/closed/shouldsucceed/2629.v @@ -0,0 +1,22 @@ +Class Join (t: Type) : Type := mkJoin {join: t -> t -> t -> Prop}. + +Class sepalg (t: Type) {JOIN: Join t} : Type := + SepAlg { + join_eq: forall {x y z z'}, join x y z -> join x y z' -> z = z'; + join_assoc: forall {a b c d e}, join a b d -> join d c e -> + {f : t & join b c f /\ join a f e}; + join_com: forall {a b c}, join a b c -> join b a c; + join_canc: forall {a1 a2 b c}, join a1 b c -> join a2 b c -> a1=a2; + + unit_for : t -> t -> Prop := fun e a => join e a a; + join_ex_units: forall a, {e : t & unit_for e a} +}. + +Definition joins {A} `{Join A} (a b : A) : Prop := + exists c, join a b c. + +Lemma join_joins {A} `{sepalg A}: forall {a b c}, + join a b c -> joins a b. +Proof. + firstorder. +Qed. |