I'm trying to define a non-dependent list type in Coq, but I cannot figure out a way to do that. I managed to define ndList axiomatically, modifying Coq's list definition. Here's my work so far:
Axiom ndList : forall C: Type, Type.
Axiom nil : forall C, ndList C.
Axiom cons : forall C, forall (c: C) (l: ndList C), ndList C.
Arguments nil {_}.
Arguments cons {_} _ _.
Axiom el : forall (C L: Type), forall (a: L) (s: ndList C)
(l: forall (x: C) (z: L), L), L.
Axiom c1 : forall (C L: Type), forall (a: L) (l: forall (x: C) (z: L), L),
el C L a nil l = a.
Axiom c2 : forall (C L: Type), forall (s: ndList C) (c: C) (a: L)
(l: forall (x: C) (z: L), L),
el C L a (cons c s) l = l c (el C L a s l).
Axiom c_eta : forall (C L: Type), forall (a: L) (l: forall (x: C) (z: L), L)
(t: forall y: ndList C, L) (s: ndList C) (eq1: t nil = a)
(eq2: forall (x: C) (z: ndList C), t (cons x z) = l x (t z)),
el C L a s l = t s.
Is there a way to define ndList as an Inductive type?
Thanks for helping.
Your "non-dependent" list type is provably isomorphic to Coq's list type:
Axiom ndList : forall C: Type, Type.
Axiom nil : forall C, ndList C.
Axiom cons : forall C, forall (c: C) (l: ndList C), ndList C.
Arguments nil {_}.
Arguments cons {_} _ _.
Axiom el : forall (C L: Type), forall (a: L) (s: ndList C)
(l: forall (x: C) (z: L), L), L.
Axiom c1 : forall (C L: Type), forall (a: L) (l: forall (x: C) (z: L), L),
el C L a nil l = a.
Axiom c2 : forall (C L: Type), forall (s: ndList C) (c: C) (a: L)
(l: forall (x: C) (z: L), L),
el C L a (cons c s) l = l c (el C L a s l).
Axiom c_eta : forall (C L: Type), forall (a: L) (l: forall (x: C) (z: L), L)
(t: forall y: ndList C, L) (s: ndList C) (eq1: t nil = a)
(eq2: forall (x: C) (z: ndList C), t (cons x z) = l x (t z)),
el C L a s l = t s.
Section iso.
Context {A : Type}.
Definition list_to_ndList : list A -> ndList A
:= list_rect (fun _ => ndList A)
nil
(fun x _ xs => cons x xs).
Definition ndList_to_list (ls : ndList A) : list A
:= el A (list A)
Datatypes.nil
ls
Datatypes.cons.
Lemma list_eq (ls : list A) : ndList_to_list (list_to_ndList ls) = ls.
Proof.
unfold ndList_to_list, list_to_ndList.
induction ls as [|x xs IHxs];
repeat first [ progress simpl
| progress rewrite ?c1, ?c2
| congruence ].
Qed.
Lemma ndList_eq (ls : ndList A) : list_to_ndList (ndList_to_list ls) = ls.
Proof.
unfold ndList_to_list, list_to_ndList.
transitivity (el A (ndList A) nil ls cons); [ symmetry | ]; revert ls;
match goal with
| [ |- forall ls, #?LHS ls = #?RHS ls ]
=> intro ls; apply (c_eta _ _ _ _ RHS ls)
end;
repeat first [ progress simpl
| progress intros
| progress rewrite ?c1, ?c2
| congruence ].
Qed.
End iso.
You can also easily get your el about lists, automatically, even:
Scheme el := Minimality for list Sort Type.
Check el. (* forall A P : Type, P -> (A -> list A -> P -> P) -> list A -> P *)
Does this suffice for your purposes, or are you wanting more?
Related
Is functional extensionality provable for John Major's equality (possibly relying on safe axioms)?
Goal forall A (P:A->Type) (Q:A->Type)
(f:forall a, P a) (g:forall a, Q a),
(forall a, JMeq (f a) (g a)) -> JMeq f g.
If not, is it safe to assume it as an axiom?
It's provable from usual function extensionality.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Logic.JMeq.
Theorem jmeq_funext
A (P : A -> Type) (Q : A -> Type)
(f : forall a, P a)(g : forall a, Q a)
(h : forall a, JMeq (f a) (g a)) : JMeq f g.
Proof.
assert (pq_eq : P = Q).
apply functional_extensionality.
exact (fun a => match (h a) with JMeq_refl => eq_refl end).
induction pq_eq.
assert (fg_eq : f = g).
apply functional_extensionality_dep.
exact (fun a => JMeq_rect (fun ga => f a = ga) eq_refl (h a)).
induction fg_eq.
exact JMeq_refl.
Qed.
Following Adam Chlipala's definition of heterogeneous lists, I wanted to define an equivalent of the Forall function on normal lists. This isn't too difficult, and you end up with two constructors as usual. Now suppose that I know that a fact is true about every element of a non-empty list. With normal lists, I could use Forall_inv and Forall_inv_tail to assert that it's true about the head and tail of the list.
I'd like to prove the equivalent for hForall as defined below, starting with the head case. Looking at the source in Lists/List.v, the proof for normal lists is easy and runs by inversion on Forall (a :: l). The equivalent for my hForall gives a mess of dependent variables. Am I missing something obvious?
Require Import List.
Section hlist.
Variable A : Type.
Variable B : A -> Type.
Inductive hlist : list A -> Type :=
| HNil : hlist nil
| HCons {a : A} {ls : list A} : B a -> hlist ls -> hlist (a :: ls).
Section hForall.
Variable P : forall a : A, B a -> Prop.
Inductive hForall : forall {As : list A}, hlist As -> Prop :=
| hForall_nil : hForall HNil
| hForall_cons {a : A} {ls : list A} (x : B a) (hl : hlist ls)
: P a x -> hForall hl -> hForall (HCons x hl).
Lemma hForall_inv
(a : A)
(ls : list A)
(x : B a)
(hl : hlist ls)
: hForall (HCons x hl) -> P a x.
Proof.
(* Help! *)
Abort.
End hForall.
End hlist.
Inductives indexed by indexed types lead to that kind of difficulty.
Alternatively, consider defining hForall as a Fixpoint. Then the inversion lemma follows by just unfolding the definition.
Section hForall'.
Variable P : forall a, B a -> Prop.
Fixpoint hForall' {As : list A} (hs : hlist As) : Prop :=
match hs with
| HNil => True
| HCons x js => P _ x /\ hForall' js
end.
Lemma hForall'_inv
(a : A)
(ls : list A)
(x : B a)
(hl : hlist ls)
: hForall' (HCons x hl) -> P a x.
Proof.
intros []; auto.
Qed.
End hForall'.
Appendix
Mostly for educational purposes, here's a few ways to prove that inversion lemma for the original inductive definition of hForall (starting from the simpler to use).
One solution is the dependent destruction tactic, which also automatically handles heterogeneous equalities, as opposed to destruct. It is imported from the Program module:
Import Program.
Lemma hForall_inv
(a : A)
(ls : list A)
(x : B a)
(hl : hlist ls)
: hForall (HCons x hl) -> P a x.
Proof.
intros H.
dependent destruction H.
auto.
Qed.
The (minor) catch is that it uses some axioms about heterogeneous equality:
Print Assumptions hForall_inv.
(*
Section Variables:
P : forall a : A, B a -> Prop
B : A -> Type
A : Type
Axioms:
Eqdep.Eq_rect_eq.eq_rect_eq : forall (U : Type) (p : U)
(Q : U -> Type) (x : Q p)
(h : p = p), x = eq_rect p Q x p h
JMeq_eq : forall (A : Type) (x y : A), x ~= y -> x = y
*)
With a little more knowledge of how destruct works/dependent pattern-matching, here's a proof without axioms.
There are some detailed explanations of dependent pattern-matching in CPDT, but briefly the issue is that when we do destruct/inversion on hForall (HCons x hl), the index HCons x hl gets generalized before the case-split, so you get a nonsensical case where it is replaced with HNil, and a second case with a different index HCons x0 hl0, and a good way of remembering the (heterogeneous) equality across that generalization is a research-grade problem. You wouldn't need to mess with heterogeneous equalities if the goal just got rewritten with those variables, and indeed you can refactor the goal so that it explicitly depends on HCons x hl, instead of x and hl separately, which will then be generalized by destruct:
Lemma hForall_inv'
(a : A)
(ls : list A)
(x : B a)
(hl : hlist ls)
: hForall (HCons x hl) -> P a x.
Proof.
intros H.
change (match HCons x hl return Prop with (* for some reason you have to explicitly annotate the return type as Prop right here *)
| HNil => True
| HCons x _ => P _ x
end).
destruct H.
- exact I. (* Replace [HCons x hl] with [HNil], the goal reduces to [True]. (This is an unreachable case.) *)
- assumption.
(* Or, directly writing down the proof term. *)
Restart.
intros H.
refine (match H in #hForall As hs return
match hs return Prop with
| HNil => True
| HCons x _ => P _ x
end
with
| hForall_nil => I
| hForall_cons _ _ _ _ => _
end).
assumption.
Qed.
The Equations plugin probably automates that properly, but I haven't tried.
I think the easiest way to solve this kind of destructing is by telling Coq that we care about these destructed patterns.
Alternately, you can use remember tactic, but sometimes it will make more hard reason about your theorem.
Lemma hForall_inv
(a : A)
(ls : list A)
(x : B a)
(hl : hlist ls)
: hForall (HCons x hl) -> P a x.
Proof.
have : forall (F : forall (a : A) (ls : list A) (x : B a) (hl : hlist ls) (H : hForall (HCons x hl)), Prop),
(forall (a : A) (ls : list A) (x : B a) (hl : hlist ls) (H : hForall (HCons x hl)) (I : forall (a : A) (ls : list A) (x : B a) (hl : hlist ls) (f : P a x) (H : hForall (HCons x hl)), F a ls x hl H),
F a ls x hl H).
intros.
refine (match H in (hForall (HCons x hl)) return F _ _ _ _ H with
|hForall_nil => _
|hForall_cons a x y z => _
end).
exact idProp.
exact (I _ _ _ _ y (hForall_cons a x y z)).
move => forall_rect.
elim/forall_rect; by [].
Qed.
An observation I am using Type to enables elimination :
Inductive hForall : forall {As : list A}, hlist As -> Type :=
| hForall_nil : hForall HNil
| hForall_cons {a : A} {ls : list A} (x : B a) (hl : hlist ls)
: P a x -> hForall hl -> hForall (HCons x hl).
I got stuck while doing some coq proofs around the state monad. Concretely, I've simplified the situation to this proof:
Definition my_call {A B C} (f : A -> B * C) (a : A) : B * C :=
let (b, c) := f a in (b, c).
Lemma mycall_is_call : forall {A B C} (f : A -> B * C) (a : A), my_call f a = f a.
Proof.
intros A B C f a.
unfold my_call.
(* stuck! *)
Abort.
The resulting goal after invoking unfold is (let (b, c) := f a in (b, c)) = f a. If I'm not wrong, both sides of the equality should be exactly the same, but I don't know how to show it from here. Any help?
--
As a side note, I've seen that coq automatically applies the simplification when no product types are involved in the result of the function:
Definition my_call' {A B : Type} (f : A -> B) (a : A) : B :=
let b := f a in b.
Lemma my_call_is_call' : forall A B (f : A -> B) (a : A), my_call' f a = f a.
Proof.
intros A B f a.
unfold my_call'.
reflexivity.
Qed.
It's easy to see what you need to do next, once you recall that
let (b, c) := f a in (b, c)
is syntactic sugar for
match f a with (b, c) => (b, c) end
This means you need to destruct on f a to finish the proof:
Lemma mycall_is_call {A B C} (f : A -> B * C) a :
my_call f a = f a.
Proof.
unfold my_call.
now destruct (f a).
Qed.
I defined a Boole inductive type based on the disjoint sum's definition:
Inductive Boole :=
| inlb (a: unit)
| inrb (b: unit).
Given two types A and B I'm trying to prove the ismorphism between
sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))
and
A + B
I managed to prove one side of the isomorphism
Definition sum_to_sigT {A} {B} (z: A + B) :
sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B)).
Proof.
case z.
move=> a.
exists (inrb tt).
rewrite //=.
move=> b.
exists (inlb tt).
rewrite //=.
Defined.
Lemma eq_inla_inltt (a: unit) : eq (inlb a) (inlb tt).
Proof.
by case a.
Qed.
Lemma eq_inra_inrtt (a: unit) : eq (inrb a) (inrb tt).
Proof.
by case a.
Qed.
Definition sigT_to_sum {A} {B}
(w: sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))) :
A + B.
Proof.
destruct w.
destruct p.
destruct x.
apply (inr (b (eq_inla_inltt a0))).
apply (inl (a (eq_inra_inrtt b0))).
Defined.
Definition eq_sum_sigT {A} {B} (x: A + B):
eq x (sigT_to_sum (sum_to_sigT x)).
Proof.
by case x.
Defined.
But I'm in trouble in proving the other side, basically because I don't manage to establish equality between the different x and p involved in the following proof:
Definition eq_sigT_sum {A} {B}
(y: sigT (fun x: Boole => prod ((eq x (inrb tt)) -> A) (eq x (inlb tt) -> B))) : eq y (sum_to_sigT (sigT_to_sum y)).
Proof.
case: (sum_to_sigT (sigT_to_sum y)).
move=> x p.
destruct y.
destruct x.
destruct p.
Defined.
Does anyone know how I can prove the latter lemma?
Thanks for the help.
As bizarre as this sounds, you cannot prove this result in Coq's theory.
Let's call the type sigT (fun x => prod (eq x (inrb tt) -> A) (eq x (inlb tt) -> B)) simply T. Any element of T has the form existT x (pair f g), where x : Boole, f : eq x (inrb tt) -> A, and g : eq x (inlb tt) -> B. To show your result, you need to argue that two expressions of type T are equal, which will require at some point proving that two terms f1 and f2 of type eq x (inrb tt) -> A are equal.
The problem is that elements of eq x (inrb tt) -> A are functions: they take as input a proof that x and inrb tt are equal, and produce a term of type A as a result. And sadly, the notion of equality for functions in Coq is too weak to be useful in most cases. Normally in math, we would argue that two functions are equal by showing that they produce the same results, that is:
forall f g : A -> B,
(forall x : A, f x = g x) -> f = g.
This principle, usually known as functional extensionality, is not available in Coq by default. Fortunately, the theory allows us to safely add it as an axiom without compromising the soundness of the theory. It is even available to us in the standard library. I've included here a proof of a slightly modified version of your result. (I've taken the liberty of using the ssreflect library, since I saw you were using it too.)
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.
Require Import Coq.Logic.FunctionalExtensionality.
Section Iso.
Variables A B : Type.
Inductive sum' :=
| Sum' x of x = true -> A & x = false -> B.
Definition sum'_of_sum (x : A + B) :=
match x with
| inl a =>
Sum' true
(fun _ => a)
(fun e : true = false =>
match e in _ = c return if c then A else B with
| erefl => a
end)
| inr b =>
Sum' false
(fun e =>
match e in _ = c return if c then A else B with
| erefl => b
end)
(fun _ => b)
end.
Definition sum_of_sum' (x : sum') : A + B :=
let: Sum' b f g := x in
match b return (b = true -> A) -> (b = false -> B) -> A + B with
| true => fun f _ => inl (f erefl)
| false => fun _ g => inr (g erefl)
end f g.
Lemma sum_of_sum'K : cancel sum_of_sum' sum'_of_sum.
Proof.
case=> [[]] /= f g; congr Sum'; apply: functional_extensionality => x //;
by rewrite (eq_axiomK x).
Qed.
End Iso.
I am trying to make the following work:
Definition gen `{A:Type}
{i o: nat}
(f: nat -> (option nat))
{ibound: forall (n n':nat), f n = Some n' -> n' < i}
(x: svector A i) (t:nat) (ti: t < o): option A
:= match (f t) with
| None => None
| Some t' => Vnth x (ibound t t' _)
end.
In place of last "_" I need an evidence that "f t" is equals to "Some t'". I could not figure out how to get it from the match. Vnth is defined as:
Vnth
: ∀ (A : Type) (n : nat), vector A n → ∀ i : nat, i < n → A
Writing this function requires an instance of what is known as the convoy pattern (see here). I believe the following should work, although I can't test it, since I don't have the rest of your definitions.
Definition gen `{A:Type}
{i o: nat}
(f: nat -> (option nat))
{ibound: forall (n n':nat), f n = Some n' -> n' < i}
(x: svector A i) (t:nat) (ti: t < o): option A
:= match f t as x return f t = x -> option A with
| None => fun _ => None
| Some t' => fun p => Vnth x (ibound t t' p)
end (eq_refl (f t)).