I am experimenting with possibility of embedding of HOL4 proofs in Coq.
In HOL it is possible to give definition like
fun ALPHA t1 t2 = TRANS (REFL t1) (REFL t2)
Is it possible to somehow define this function in Coq in similar way? My attempt fails on the last line due to
The term "REFL t2" has type "t2 == t2"
while it is expected to have type "t1 == ?t3" (cannot unify
"t2" and "t1").
The code:
Axiom EQ : forall {aa:Type}, aa -> aa -> Prop.
Notation " x == y " := (#EQ _ x y) (at level 80).
Axiom REFL : forall {aa:Type} (a:aa), a == a.
Axiom TRANS :forall {T:Type}{t1 t2 t3:T},
(t1 == t2) -> (t2 == t3) -> (t1 == t3).
Definition ALPHA t1 t2 := TRANS (REFL t1) (REFL t2).
ADDED:
Maybe there is a method of defining ALPHA such that we can assume that t1=t2? (I mean indeed, in Coq's standard sense of equality). I cann add assumption (H:t1=t2), but then I need to have matching somehow. How to do the matching with equality?
Definition ALPHA (t1 t2:T) (H:t1=t2) : t1==t2 :=
match H with
| eq_refl _ => TRANS (REFL t1) (REFL t2)
end
. (*fails*)
Can you say more about how this definition is supposed to work in HOL? If I'm guessing correctly, ALPHA is supposed to be a thing that fails to typecheck if its arguments are not alpha-convertible? In Coq, you can use
Notation ALPHA t1 t2 := (TRANS (REFL t1) (REFL t2)).
You could also do
Notation ALPHA t1 t2 := (REFL t1 : t1 == t2).
or
Notation ALPHA t1 t2 := (eq_refl : t1 = t2).
Then you can write things like Check ALPHA foo bar to see if two things are convertible. But I don't think this will be useful in most situations. If you're looking for tactic programming, perhaps you're looking for the unify tactic or the constr_eq tactic?
Alternatively, if you want your match statement to work, you can write
Definition ALPHA {T:Type} (t1 t2 : T) (H : t1 = t2) : t1 == t2 :=
match H with eq_refl => REFL _ end.
This is not a unification problem, it really is a typing problem.
REFL t1 has type t1 == t1 and REFL t2 has type t2 == t2 as the error message is telling you. Transitivity would only work if somehow t1 and t2 were the same, but this is a priori not the case.
Perhaps what you wrote is not what you think you wrote.
If we were using only t1, then TRANS (REFL t1) (REFL t1) has type t1 == t1. Were you expecting ALPHA t1 t2 to have type t1 == t2?
If it is the case, then your EQ relation would be total.
Related
I have next definitions (code can be compiled):
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Set Asymmetric Patterns.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Inductive val : Set := VConst of nat | VPair of val & val.
Inductive type : Set := TNat | TPair of type & type.
Inductive tjudgments_val : val -> type -> Prop :=
| TJV_nat n :
tjudgments_val (VConst n) TNat
| TJV_pair v1 t1 v2 t2 :
tjudgments_val v1 t1 ->
tjudgments_val v2 t2 ->
tjudgments_val (VPair v1 v2) (TPair t1 t2).
And I would like to prove the following lemma:
Lemma tjexp_pair v1 t1 v2 t2 (H : tjudgments_val (VPair v1 v2) (TPair t1 t2)) :
tjudgments_val v1 t1 /\ tjudgments_val v2 t2.
Proof.
case E: _ _ / H => // [v1' t1' v2' t2' jv1 jv2].
(* case E: _ / H => // [v1' t1' v2' t2' jv1 jv2]. *)
The case E: _ _ / H => // [v1' t1' v2' t2' jv1 jv2]. leaves me with E : VPair v1 v2 = VPair v1' v2'.
The case E: _ / H => // [v1' t1' v2' t2TPair t1 t2 = TPair t1' t2'' jv1 jv2]. leaves me with E : TPair t1 t2 = TPair t1' t2'.
But it looks to me like I need both of them together. How to?
There is a way of using inversion's power with ssreflect tactics.
Derive Inversion tjudgments_val_inv with (forall v t, tjudgments_val v t).
You can use it with elim/tjudgments_val_inv: H.
The proof is straightforward after this.
In such a case, you can use the very handy inversion tactic an enhancement of the case tactic, which automatically does the kind of work of indices you are manually trying to do. Here inversion H is almost enough to finish the proof.
I'm working through CPDT, going along with the exercises from here: https://www.cis.upenn.edu/~bcpierce/courses/670Fall12/
In this case I'm on 17, here: https://www.cis.upenn.edu/~bcpierce/courses/670Fall12/HW17.v
The main relevant definition of an inductive type is here:
Inductive has_type : context -> expr -> type -> Prop :=
| T_Unit : forall ctx, has_type ctx UnitE UnitT
(* Using a separate "t = ..." parameter here eases automation: *)
| T_Var : forall ctx n t, n < length ctx ->
t = nth n ctx UnitT ->
has_type ctx (Var n) t
| T_Abs : forall ctx t1 e t2, has_type (t1 :: ctx) e t2 ->
has_type ctx (Lam t1 e) (Arrow t1 t2)
| T_App : forall ctx e1 e2 t1 t2, has_type ctx e1 (Arrow t1 t2) ->
has_type ctx e2 t1 ->
has_type ctx (App e1 e2) t2.
The exercise is that the proofs are already written, and it's up to the student to manipulate the hint database to get them to go through automatically...but I'm hitting a weird case I don't know how to think about.
Hint Constructors has_type.
Example stlc_app : has_type nil (App (App (Lam UnitT (Lam UnitT (Var 0)))
UnitE) UnitE) UnitT.
eauto 10.
Qed.
This doesn't work...but oddly, this does:
Example stlc_app : has_type nil (App (App (Lam UnitT (Lam UnitT (Var 0)))
UnitE) UnitE) UnitT.
repeat econstructor.
Qed.
Furthermore, I tried different values for eauto n and it's clear that it is just returning instantly...
I believe that eauto uses eapply x, not econstructor, but eapply T_App also works...so I'm not sure why it is short circuiting.
Note that when I run Hint Constructors has_type, I get this message:
The hint T_App will only be used by eauto, because applying T_App would leave variable t1 as unresolved existential variable.
But we are in fact using eauto, so I'm not sure what is going on. And the info command that CPDT mentions doesn't work anymore.
I tried the following hint:
Hint Extern 1 (has_type _ _ _) => econstructor.
But that didn't work, which is weird because repeat econstructor in fact solves the target.
I'd love some advice on better understanding why the Hint Extern doesn't work, as well as why the eauto isn't properly invoking the constructor. Thank you!
After applying constructors 5 times, we come up with a goal
0 < length (UnitT :: UnitT :: nil)
and this is where eauto stucks.
This kind of simple arithmetic proposition can be solved by eauto with arith hint database.
So eauto 10 with arith can solve stlc_app.
For a project I'm coding group theory through Coq, obviously associatvity of 3 elements is a given, however I'm struggling to prove it holds for a string of length n. That is, (x1 * ... * xn) is always the same regardless of how many brackets are in there, or there placement.
The relevant group code is
Structure group :=
{
e : G;
Op : G -> G -> G;
Inv : G -> G;
Associativity : forall (x y z : G), Op x (Op y z) = Op (Op x y) z;
LeftInverse : forall (x : G), Op (Inv x) x = e;
LeftIdentity : forall (x : G), Op e x = x;
}.
It's not the proof itself I have the issue with but how to code it. I can see at the very least I'll need a further function that allows me to operate on strings rather than just elements, but i've no idea how to get started. Any pointers?
Operating on strings directly is certainly possible, but cumbersome. When reasoning about languages, it is much more convenient to use abstract syntax trees instead. For your statement, we only want to consider combinations of elements with some binary operation, so a binary tree suffices:
Inductive tree T :=
| Leaf : T -> tree T
| Node : tree T -> tree T -> tree T.
For concreteness, I'll only consider the natural numbers under addition, but this generalizes to any other monoid (and thus any other group). We can write a function that sums all the elements of a tree:
Fixpoint sum_tree t : nat :=
match t with
| Leaf n => n
| Node t1 t2 => sum_tree t1 + sum_tree t2
end.
We can also write a function that flattens the tree, collecting all of its elements in a list
Fixpoint elements {T} (t : tree T) : list T :=
match t with
| Leaf x => [x]
| Node t1 t2 => elements t1 ++ elements t2
end.
With these ingredients, we can formulate the statement that you were looking for: if two trees (that is, two ways of putting parenthesis in an expression) have the same sequences of elements, then they must add up to the same number.
Lemma eq_sum_tree t1 t2 :
elements t1 = elements t2 -> sum_tree t1 = sum_tree t2.
I'll leave the proof of this statement to you. ;)
Let's say I have again a small problem with my datatype with an existential quantified component. This time I want to define when two values of type ext are equal.
Inductive ext (A: Set) :=
| ext_ : forall (X: Set), option X -> ext A.
Fail Definition ext_eq (A: Set) (x y: ext A) : Prop :=
match x with
| ext_ _ ox => match y with
| ext_ _ oy => (* only when they have the same types *)
ox = oy
end
end.
What I'd like to do is somehow distinguish between the cases where the existential type is actually same and where it's not. Is this a case for JMeq or is there some other way to accomplish such a case distinction?
I googled a lot, but unfortunately I mostly stumbled upon posts about dependent pattern matching.
I also tried to generate a (boolean) scheme with Scheme Equality for ext, but this wasn't successful because of the type argument.
What I'd like to do is somehow distinguish between the cases where the existential type is actually same and where it's not.
This is not possible as Coq's logic is compatible with the univalence axiom which says that isomorphic types are equal. So even though (unit * unit) and unit are syntactically distinct, they cannot be distinguished by Coq's logic.
A possible work-around is to have a datatype of codes for the types you are interested in and store that as an existential. Something like this:
Inductive Code : Type :=
| Nat : Code
| List : Code -> Code.
Fixpoint meaning (c : Code) := match c with
| Nat => nat
| List c' => list (meaning c')
end.
Inductive ext (A: Set) :=
| ext_ : forall (c: Code), option (meaning c) -> ext A.
Lemma Code_eq_dec : forall (c d : Code), { c = d } + { c <> d }.
Proof.
intros c; induction c; intros d; destruct d.
- left ; reflexivity.
- right ; inversion 1.
- right ; inversion 1.
- destruct (IHc d).
+ left ; congruence.
+ right; inversion 1; contradiction.
Defined.
Definition ext_eq (A: Set) (x y: ext A) : Prop.
refine(
match x with | #ext_ _ c ox =>
match y with | #ext_ _ d oy =>
match Code_eq_dec c d with
| left eq => _
| right neq => False
end end end).
subst; exact (ox = oy).
Defined.
However this obviously limits quite a lot the sort of types you can pack in an ext. Other, more powerful, languages (e.g. equipped with Induction-recursion) would give you more expressive power.
Suppose I have a premise like this:
H2: ~ a b c <> a b c
And I wish to change it to:
a b c = a b c
Where
a is Term -> Term -> Term
b and c are both Term
How can I do it? Thanks!
If you unfold the definitions of ~ and <>, you hypothesis has the following type:
H2: (a b c = a b c -> False) -> False
Therefore, what you wish to achieve is what logicians usually call "double negation elimination". It is not an intuitionistically-provable theorem, and is therefore defined in the Classical module of Coq (see http://coq.inria.fr/distrib/V8.4/stdlib/Coq.Logic.Classical_Prop.html for details):
Classical.NNPP : forall (p : Prop), ~ ~ p -> p
I assume your actual problem is more involved than a b c = a b c, but for the sake of mentioning it, if you really care about obtaining that particular hypothesis, you can safely prove it without even looking at H2:
assert (abc_refl : a b c = a b c) by reflexivity.
If your actual example is not immediately reflexive and the equality is actually false, maybe you want to turn your goal into showing that H2 is absurd. You can do so by eliminating H2 (elim H2., which is basically doing a cut on the False type), and you will end up in the context:
H2 : ~ a b c <> a b c
EQ : a b c = a b c
=====================
False
I'm not sure whether all of this helps, but you might have oversimplified your problem so that I cannot provide more insight on what your real problem is.
Just a little thought to add to Ptival's answer - if your desired goal was not trivially solved by reflexivity, you could still make progress provided you had decidable equality on your Term, for example by applying this little lemma:
Section S.
Parameter T : Type.
Parameter T_eq_dec : forall (x y : T), {x = y} + {x <> y}.
Lemma not_ne : forall (x y : T), ~ (x <> y) -> x = y.
Proof.
intros.
destruct (T_eq_dec x y); auto.
unfold not in *.
assert False.
apply (H n).
contradiction.
Qed.
End S.