Problems with dependent types in Coq proof assistant - coq

Consider the following simple expression language:
Inductive Exp : Set :=
| EConst : nat -> Exp
| EVar : nat -> Exp
| EFun : nat -> list Exp -> Exp.
and its wellformedness predicate:
Definition Env := list nat.
Inductive WF (env : Env) : Exp -> Prop :=
| WFConst : forall n, WF env (EConst n)
| WFVar : forall n, In n env -> WF env (EVar n)
| WFFun : forall n es, In n env ->
Forall (WF env) es ->
WF env (EFun n es).
which basically states that every variable and function symbols must be defined in the environment. Now, I want to define a function that states the decidability of WF predicate:
Definition WFDec (env : Env) : forall e, {WF env e} + {~ WF env e}.
refine (fix wfdec e : {WF env e} + {~ WF env e} :=
match e as e' return e = e' -> {WF env e'} + {~ WF env e'} with
| EConst n => fun _ => left _ _
| EVar n => fun _ =>
match in_dec eq_nat_dec n env with
| left _ _ => left _ _
| right _ _ => right _ _
end
| EFun n es => fun _ =>
match in_dec eq_nat_dec n env with
| left _ _ => _
| right _ _ => right _ _
end
end (eq_refl e)) ; clear wfdec ; subst ; eauto.
The trouble is how to state that WF predicate holds or not for a list of expressions in the EFun case. My obvious guess was:
...
match Forall_dec (WF env) wfdec es with
...
But Coq refuses it, arguing that the recursive call wfdec is ill-formed. My question is: Is it possible to define decidability of such wellformedness predicate without changing the expression representation?
The complete working code is at the following gist.

The problem is that Forall_dec is defined as opaque in the standard library (that is, with Qed instead of Defined). Because of that, Coq does not know that the use of wfdec is valid.
The immediate solution to your problem is to redefine Forall_dec so that it is transparent. You can do this by printing the proof term that Coq generates and pasting it in your source file. I've added a gist here with a complete solution.
Needless to say, this approach lends itself to bloated, hard to read, and hard to maintain code. As ejgallego was pointing out in his answer, your best bet in this case is probably to define a Boolean function that decides WF, and use that instead of WFDec. The only problem with his approach, as he said, is that you will need to write your own induction principle to Exp in order to prove that the Boolean version indeed decides the inductive definition. Adam Chlipala's CPDT has a chapter on inductive types that gives an example of such an induction principle; just look for "nested inductive types".

As a temporal workaround you can define wf as:
Definition wf (env : Env) := fix wf (e : Exp) : bool :=
match e with
| EConst _ => true
| EVar v => v \in env
| EFun v l => [&& v \in env & all wf l]
end.
which is usually way more convenient to use. However, this definition will be pretty useless due to Coq generating the wrong induction principle for exp, as it doesn't detect the list. What I usually do is to fix the induction principle manually, but this is costly. Example:
From Coq Require Import List.
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Printing Implicit Defensive.
Import Prenex Implicits.
Section ReflectMorph.
Lemma and_MR P Q b c : reflect P b -> reflect Q c -> reflect (P /\ Q) (b && c).
Proof. by move=> h1 h2; apply: (iffP andP) => -[/h1 ? /h2 ?]. Qed.
Lemma or_MR P Q b c : reflect P b -> reflect Q c -> reflect (P \/ Q) (b || c).
Proof. by move=> h1 h2; apply: (iffP orP) => -[/h1|/h2]; auto. Qed.
End ReflectMorph.
Section IN.
Variables (X : eqType).
Lemma InP (x : X) l : reflect (In x l) (x \in l).
Proof.
elim: l => [|y l ihl]; first by constructor 2.
by apply: or_MR; rewrite // eq_sym; exact: eqP.
Qed.
End IN.
Section FORALL.
Variables (X : Type) (P : X -> Prop).
Variables (p : X -> bool).
Lemma Forall_inv x l : Forall P (x :: l) -> P x /\ Forall P l.
Proof. by move=> U; inversion U. Qed.
Lemma ForallP l : (forall x, In x l -> reflect (P x) (p x)) -> reflect (Forall P l) (all p l).
Proof.
elim: l => [|x l hp ihl /= ]; first by constructor.
have/hp {hp}hp : forall x : X, In x l -> reflect (P x) (p x).
by move=> y y_in; apply: ihl; right.
have {ihl} ihl := ihl _ (or_introl erefl).
by apply: (iffP andP) => [|/Forall_inv] [] /ihl hx /hp hall; constructor.
Qed.
End FORALL.
Inductive Exp : Type :=
| EConst : nat -> Exp
| EVar : nat -> Exp
| EFun : nat -> list Exp -> Exp.
Lemma Exp_rect_list (P : Exp -> Type) :
(forall n : nat, P (EConst n)) ->
(forall n : nat, P (EVar n)) ->
(forall (n : nat) (l : seq Exp), (forall x, In x l -> P x) -> P (EFun n l)) ->
forall e : Exp, P e.
Admitted.
Definition Env := list nat.
Definition wf (env : Env) := fix wf (e : Exp) : bool :=
match e with
| EConst _ => true
| EVar v => v \in env
| EFun v l => [&& v \in env & all wf l]
end.
Inductive WF (env : Env) : Exp -> Prop :=
| WFConst : forall n, WF env (EConst n)
| WFVar : forall n, In n env -> WF env (EVar n)
| WFFun : forall n es, In n env ->
Forall (WF env) es ->
WF env (EFun n es).
Lemma WF_inv env e (wf : WF env e ) :
match e with
| EConst n => True
| EVar n => In n env
| EFun n es => In n env /\ Forall (WF env) es
end.
Proof. by case: e wf => // [n|n l] H; inversion H. Qed.
Lemma wfP env e : reflect (WF env e) (wf env e).
Proof.
elim/Exp_rect_list: e => [n|n|n l ihe] /=; try repeat constructor.
by apply: (iffP idP) => [/InP|/WF_inv/InP //]; constructor.
apply: (iffP andP) => [[/InP ? /ForallP H]|/WF_inv[/InP ? /ForallP]].
by constructor => //; exact: H.
by auto.
Qed.

Related

Issue around the 'elim restriction'

I am currently going through the book 'Computational Type Theory and Interactive Theorem Proving with Coq' by Gert Smolka, and on page 93, the following inductive predicate is defined:
Inductive G (f:nat -> bool) : nat -> Prop :=
| mkG : forall (n:nat), (f n = false -> G f (S n)) -> G f n
.
Then on page 95 it is argued that one can define an eliminator:
Definition elimG : forall (f:nat -> bool) (p:nat -> Type),
(forall (n:nat), (f n = false -> p (S n)) -> p n) ->
forall (n:nat), G f n -> p n.
Proof.
...
The book spells out an expression of a term of this type, namely:
elimG f p g n (mkG _ _ h) := g n (λe. elimG f p g (S n) (h e))
(I have changed a few notations for the purpose of this post)
which I formally translated as:
refine (
fun (f:nat -> bool) (p:nat -> Type) =>
fun (H1:forall (n:nat), (f n = false -> p (S n)) -> p n) =>
fun (n:nat) (H2:G f n) =>
match H2 with
| mkG _ _ H3 => _
end
).
However, Coq will not allow me to carry out the pattern match due to the elim restriction.
The book informally says "Checking that the defining equation of elimG is well-typed is not difficult"
I am posting this in the hope that someone familiar with the book will have an opinion as to whether the author made a mistake, or whether I am missing something.
EDIT:
Having played around with the two answers below, the simplest term expression I have come up with is as follows:
Definition elimG
(f:nat -> bool)
(p:nat -> Type)
(g: forall (n:nat), (f n = false -> p (S n)) -> p n)
: forall (n:nat), G f n -> p n
:= fix k (n:nat) (H:G f n) : p n := g n
(fun e => k (S n)
( match H with
| mkG _ _ H => H
end e)).
This definition is possible, there's just a subtlety here. The G (which is in Prop) is never needed to make a decision here, because it only has one constructor. So you just do the
elimG f p g n h := g n (λe. elimG f p g (S n) _)
"unconditionally" outside of any match on h. That hole now has expected type G f (S n), which now is in Prop, and we can do our match on h there. We also have to do some rewriting shenanigans with the match. Putting everything together, we write
Fixpoint elimG
(f : nat -> bool) (p : nat -> Type)
(g : forall (n:nat), (f n = false -> p (S n)) -> p n)
(n : nat) (H : G f n) {struct H}
: p n :=
g n
(fun e =>
elimG f p g (S n)
(match H in G _ n return f n = false -> G f (S n) with (* in and return clause can be inferred; we're rewriting the n in e's type *)
| mkG _ _ H => H
end e)).
That's a tricky one.
The author is not wrong, it is possible to define such an elimination principle but you have to be careful about how and when you match on your hypothesis.
The error that you get from Coq is that you are matching on a proposition to build an element of a Type. Coq forbid this so that proposition can be erased when extracting code, so you cannot do such a case-analysis of a proposition to build some computationally meaningful object (there are exceptions to this rule for instance for empty propositions).
Since you cannot start by pattern matching on H2, you can try to push this case-analysis as late as possible. Here you only need to do the case analysis in the application (h e) so you could replace it by match H2 with mkG _ n' h -> h e end.
However this does not work because h is of type f' n' = false -> ... whereas e : f n = false and you need to explain to Coq that n and n' are the same. This is achieved through dependent pattern matching, putting the apllication outside of the match and using a return clause in the script below (actually Coq can infer this return clause, I'm just leaving it for explanations).
Inductive G (f:nat -> bool) : nat -> Prop :=
| mkG : forall (n:nat), (f n = false -> G f (S n)) -> G f n
.
Fixpoint elimG (f:nat -> bool) (p:nat -> Type)
(g : forall (n:nat), (f n = false -> p (S n)) -> p n)
(n:nat) (H : G f n) {struct H} : p n.
Proof.
refine (g n (fun e => elimG f p g (S n) _)).
refine (match H in G _ n0 return f n0 = false -> G f (S n0) with mkG _ _ h => h end e).
Qed.

Translate the PVS into Coq

I want to translate the following PVS into Coq:
where type trans has type env -> env -> bool, I write the Coq code as follows:
Definition trans := env -> env -> bool.
Definition dseq (P Q : trans) : trans :=
fun s1 s2 => andb (P s1 s') (Q s' s2).
However, I have no idea to represent the Exists (s : env) in Coq. The goal of this definition is that there exists a value s that satisfies the (P s1 s) and (P s s2). I would not like to use logic since I want to prove the following theorem:
Theorem dseq_comm:
forall (F G H : trans), dseq (desq F G) H = dseq F (dseq G H).
Chances are you want to use Prop instead of bool. You can then write:
Parameter env : Type.
Definition trans := env -> env -> Prop.
Definition dseq (P Q : trans) : trans :=
fun s1 s2 => exists s', P s1 s' /\ Q s' s2.
You will be able to prove
Theorem dseq_assoc:
forall (F G H : trans), dseq (desq F G) H = dseq F (dseq G H).
if you're willing to assume Proposition extensionality.

Induction Principle for Propositions with Lists (or: LNR for expressions with nested lists)

Disclaimer: I fear this post got quite long, however, I feel that in a smaller setup some valuable background information would be lost.
I am currently trying to change my formalisation to use the locally nameless representation by Charguéraud et al [1]. Apparently, this adaption is not as straightforward as I hoped because my definition of expressions contains lists (at least I currently think this is the main problem).
So, I have the following (minimal) definition of expressions.
Require Import Coq.Lists.List.
Require Import Coq.Arith.PeanoNat.
Parameter atom : Set.
Parameter eq_atom_dec : forall x y : atom, {x = y} + {x <> y}.
Definition VarIndex := nat.
Inductive Expr : Type :=
| BVar : VarIndex -> VarIndex -> Expr
| FVar : atom -> Expr
| LetB : list Expr -> Expr -> Expr.
With this definition at hand I can define the opening operation.
Fixpoint open_rec (k: VarIndex) (u: list Expr) (e: Expr) :=
match e with
| BVar i j => if Nat.eq_dec k i then List.nth j u e else e
| FVar x => e
| LetB es e' => LetB (List.map (open_rec (S k) u) es) (open_rec (S k) u e')
end.
Notation "{ k ~> u } t" := (open_rec k u t) (at level 67).
Definition open e u := open_rec 0 u e.
So far so good. Next the property of being "locally closed" is defined inductively as follows.
Inductive lc : Expr -> Prop :=
| lc_var : forall x,
lc (FVar x)
| lc_let : forall (ts: list Expr) es e,
Forall lc es ->
lc (open e ts) ->
lc (LetB es e).
The tutorial now states that we can proof a lemma about the interaction of lc and open, i.e. in a locally closed expressions nothing happens when we substitute a variable.
(* this is a auxiliary lemma that works just fine for me *)
Lemma open_rec_lc_core : forall e (j: VarIndex) v (i: VarIndex) u,
i <> j ->
{j ~> v} e = {i ~> u} ({j ~> v} e) ->
e = {i ~> u} e.
Proof.
Admitted.
Lemma open_rec_lc0 : forall k u e,
lc e ->
e = {k ~> u} e.
Proof.
intros k u e LC.
generalize dependent k.
induction LC; intro k.
- reflexivity.
- simpl.
f_equal.
+ admit.
+ eapply open_rec_lc_core with (j := 0).
* auto.
* eapply IHLC.
Admitted.
As you can see, there is a case that is "admitted" in the proof. The problem here is that I have to proof something about the let-bindings, but everything I have at hand is the following:
H : Forall lc (map (fun e' : Expr => open e' ts) es)
LC : lc (open e ts)
IHLC : forall k : VarIndex, open e ts = {k ~> u} open e ts
What I need is an equivalent hypothesis to IHLC but for es.
My first guess was that I need to modify the induction principle as it is usually done[2] for inductive definitions with lists as arguments.
However, I cannot workout a definition that actually type checks.
Fail Definition lc_ind2 :=
fun (P : Expr -> Prop) (f : forall x : atom, P (FVar x))
(f0 : forall (ts es : list Expr) (e : Expr),
Forall lc (map (fun e' : Expr => open e' ts) es) ->
lc (open e ts) -> P (open e ts) ->
Forall P (map (fun e' => open e' ts ) es) ->
P (LetB es e)) =>
fix F (e : Expr) (l : lc e) {struct l} : P e :=
match l in (lc e0) return (P e0) with
| lc_var x => f x
| lc_let ts es e0 f1 l0 =>
f0 ts es e0 f1 l0 (F (open e0 ts) l0)
((fix F' (es: list Expr) : Forall P es :=
match es with
| nil => Forall_nil P
| cons x xs => Forall_cons x (F x _) (F' xs)
end) (map (fun e' => open e' ts) es))
end.
Instead of _ in the application of Forall_cons I need something of type lc x, but I do not know how to come up with this value.
So, in the end my question is, if someone has an idea which definitions I need to modify in order to work with the LNR.
[1] Tutorial on LNR
[2] Induction principles with list arguments
Okay, so in the end I just inlined the Forall into a local inductive definition that uses lc.
Inductive lc : Expr -> Prop :=
| lc_var : forall x,
lc (FVar x)
| lc_let : forall (ts: list Expr) es e,
Forall_lc es ->
lc (open e ts) ->
lc (LetB es e).
with Forall_lc : list Expr -> Prop :=
| nil_lc : Forall_lc nil
| cons_lc : forall e es, lc e -> Forall_lc es -> Forall_lc (e :: es).
And generated the induction principle I need.
Scheme lc2_ind := Minimality for lc Sort Prop
with lc_Forall_ind := Minimality for Forall_lc Sort Prop.
The same approach was taken here (Chapter 4).
I guess, in the end, the trick is to use mutually recursive definitions instead of trying to apply lc as a parameter to Forall.
Here is a solution that works. I do not understand all the details. For instance, in the first proof, the induction must be done on the Forall hypothesis directly, not on es to respect the guard condition. Also note the use of refine, which lets build a term iteratively, by leaving underscores to yet unknown arguments and completing gradually.
Lemma lc_ind2 : forall P : Expr -> Prop,
(forall x : atom, P (FVar x)) ->
(forall (ts es : list Expr) (e : Expr),
Forall lc es -> Forall P es ->
lc (open e ts) -> P (open e ts) -> P (LetB es e)) ->
forall e : Expr, lc e -> P e.
Proof.
intros. revert e H1.
refine (fix aux e H1 (* {struct H1} *) := match H1 with
| lc_var x => H x
| lc_let ts es e HFor Hlc => H0 ts es e HFor _ Hlc (aux (open e ts) Hlc)
end).
induction HFor.
constructor.
constructor.
apply aux. apply H2. assumption.
Qed.
Lemma Forall_map : forall {A} f (l:list A),
Forall (fun x => x = f x) l ->
l = map f l.
Proof.
intros.
induction H.
reflexivity.
simpl. f_equal; assumption.
Qed.
Lemma open_rec_lc0 : forall k u e,
lc e ->
e = {k ~> u} e.
Proof.
intros k u e H. revert k u.
induction H using lc_ind2; intros.
- reflexivity.
- simpl. f_equal.
+ apply Forall_map. apply Forall_forall. rewrite Forall_forall in H0.
intros. apply H0. assumption.
+ eapply open_rec_lc_core with (j := 0).
* auto.
* eapply IHlc.
Qed.

Implementing safe element retrieval by index from list in Coq

I'm trying to demonstrate the difference in code generation between Coq Extraction mechanism and MAlonzo compiler in Agda. I came up with this simple example in Agda:
data Nat : Set where
zero : Nat
succ : Nat → Nat
data List (A : Set) : Set where
nil : List A
cons : A → List A → List A
length : ∀ {A} → List A → Nat
length nil = zero
length (cons _ xs) = succ (length xs)
data Fin : Nat → Set where
finzero : ∀ {n} → Fin (succ n)
finsucc : ∀ {n} → Fin n → Fin (succ n)
elemAt : ∀ {A} (xs : List A) → Fin (length xs) → A
elemAt nil ()
elemAt (cons x _) finzero = x
elemAt (cons _ xs) (finsucc n) = elemAt xs n
Direct translation to Coq (with absurd pattern emulation) yields:
Inductive Nat : Set :=
| zero : Nat
| succ : Nat -> Nat.
Inductive List (A : Type) : Type :=
| nil : List A
| cons : A -> List A -> List A.
Fixpoint length (A : Type) (xs : List A) {struct xs} : Nat :=
match xs with
| nil => zero
| cons _ xs' => succ (length _ xs')
end.
Inductive Fin : Nat -> Set :=
| finzero : forall n : Nat, Fin (succ n)
| finsucc : forall n : Nat, Fin n -> Fin (succ n).
Lemma finofzero : forall f : Fin zero, False.
Proof. intros a; inversion a. Qed.
Fixpoint elemAt (A : Type) (xs : List A) (n : Fin (length _ xs)) : A :=
match xs, n with
| nil, _ => match finofzero n with end
| cons x _, finzero _ => x
| cons _ xs', finsucc m n' => elemAt _ xs' n' (* fails *)
end.
But the last case in elemAt fails with:
File "./Main.v", line 26, characters 46-48:
Error:
In environment
elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A
A : Type
xs : List A
n : Fin (length A xs)
a : A
xs' : List A
n0 : Fin (length A (cons A a xs'))
m : Nat
n' : Fin m
The term "n'" has type "Fin m" while it is expected to have type
"Fin (length A xs')".
It seems that Coq does not infer succ m = length A (cons A a xs'). What should I
tell Coq so it would use this information? Or am I doing something completely senseless?
Doing pattern matching is the equivalent of using the destruct tactic.
You won't be able to prove finofzero directly using destruct.
The inversion tactic automatically generates some equations before doing what destruct does.
Then it tries to do what discriminate does. The result is really messy.
Print finofzero.
To prove something like fin zero -> P you should change it to fin n -> n = zero -> P first.
To prove something like list nat -> P (more usually forall l : list nat, P l) you don't need to change it to list A -> A = nat -> P, because list's only argument is a parameter in its definition.
To prove something like S n <= 0 -> False you should change it to S n1 <= n2 -> n2 = 0 -> False first, because the first argument of <= is a parameter while the second one isn't.
In a goal f x = f y -> P (f y), to rewrite with the hypothesis you first need to change the goal to f x = z -> f y = z -> P z, and only then will you be able to rewrite with the hypothesis using induction, because the first argument of = (actually the second) is a parameter in the definition of =.
Try defining <= without parameters to see how the induction principle changes.
In general, before using induction on a predicate you should make sure it's arguments are variables. Otherwise information might be lost.
Conjecture zero_succ : forall n1, zero = succ n1 -> False.
Conjecture succ_succ : forall n1 n2, succ n1 = succ n2 -> n1 = n2.
Lemma finofzero : forall n1, Fin n1 -> n1 = zero -> False.
Proof.
intros n1 f1.
destruct f1.
intros e1.
eapply zero_succ.
eapply eq_sym.
eapply e1.
admit.
Qed.
(* Use the Show Proof command to see how the tactics manipulate the proof term. *)
Definition elemAt' : forall (A : Type) (xs : List A) (n : Nat), Fin n -> n = length A xs -> A.
Proof.
fix elemAt 2.
intros A xs.
destruct xs as [| x xs'].
intros n f e.
destruct (finofzero f e).
destruct 1.
intros e.
eapply x.
intros e.
eapply elemAt.
eapply H.
eapply succ_succ.
eapply e.
Defined.
Print elemAt'.
Definition elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A :=
fun A xs f => elemAt' A xs (length A xs) f eq_refl.
CPDT has more about this.
Maybe things would be clearer if at the end of a proof Coq performed eta reduction and beta/zeta reduction (wherever variables occur at most once in scope).
I think your problem is similar to Dependent pattern matching in coq . Coq's match does not infer much, so you have to help it by providing the equality by hand.

Ltac-tically abstracting over a subterm of the goal type

As a rough and untutored background, in HoTT, one deduces the heck out of the inductively defined type
Inductive paths {X : Type } : X -> X -> Type :=
| idpath : forall x: X, paths x x.
which allows the very general construction
Lemma transport {X : Type } (P : X -> Type ){ x y : X} (γ : paths x y):
P x -> P y.
Proof.
induction γ.
exact (fun a => a).
Defined.
The Lemma transport would be at the heart of HoTT "replace" or "rewrite" tactics; the trick, so far as I understand it, would be, supposing a goal which you or I can abstractly recognize as
...
H : paths x y
[ Q : (G x) ]
_____________
(G y)
to figure out what is the necessary dependent type G, so that we can apply (transport G H). So far, all I've figured out is that
Ltac transport_along γ :=
match (type of γ) with
| ?a ~~> ?b =>
match goal with
|- ?F b => apply (transport F γ)
| _ => idtac "apparently couldn't abstract" b "from the goal." end
| _ => idtac "Are you sure" γ "is a path?" end.
isn't general enough. That is, the first idtac gets used rather often.
The question is
[Is there a | what is the] Right Thing to Do?
There is a bug about using rewrite for relations in type, which would allow you to just say rewrite <- y.
In the mean time,
Ltac transport_along γ :=
match (type of γ) with
| ?a ~~> ?b => pattern b; apply (transport _ y)
| _ => idtac "Are you sure" γ "is a path?"
end.
probably does what you want.
The feature request mentioned by Tom Prince in his answer has been granted:
Require Import Coq.Setoids.Setoid Coq.Classes.CMorphisms.
Inductive paths {X : Type } : X -> X -> Type :=
| idpath : forall x: X, paths x x.
Lemma transport {X : Type } (P : X -> Type ){ x y : X} (γ : paths x y):
P x -> P y.
Proof.
induction γ.
exact (fun a => a).
Defined.
Global Instance paths_Reflexive {A} : Reflexive (#paths A) := idpath.
Global Instance paths_Symmetric {A} : Symmetric (#paths A).
Proof. intros ?? []; constructor. Defined.
Global Instance proper_paths {A} (x : A) : Proper paths x := idpath x.
Global Instance paths_subrelation
(A : Type) (R : crelation A)
{RR : Reflexive R}
: subrelation paths R.
Proof.
intros ?? p.
apply (transport _ p), RR.
Defined.
Global Instance reflexive_paths_dom_reflexive
{B} {R' : crelation B} {RR' : Reflexive R'}
{A : Type}
: Reflexive (#paths A ==> R')%signature.
Proof. intros ??? []; apply RR'. Defined.
Goal forall (x y : nat) G, paths x y -> G x -> G y.
intros x y G H Q.
rewrite <- H.
exact Q.
Qed.
I found the required instances by comparing the logs I got with Set Typeclasses Debug from setoid_rewrite <- H when H : paths x y and when H : eq x y.