First, in the case of usual open formula,
Require Import Coq.Init.Nat.
Variable x : nat.
Lemma test1:
~ exists a : nat,
let x := a in
x * x = 2.
Proof.
simpl. Admitted.
I can see that a binds to x, after simpl..
1 subgoal
______________________________________(1/1)
~ (exists a : nat, a * a = 2)
Now, I write wrapped open formula formula based on Prop,
with an unwrap operation f2p.
Require Import Coq.Init.Nat.
Require Import Lists.List.
Import ListNotations.
(* I: injection, A: and, T: then, S: square *)
Inductive formula := I (p : Prop) | A (f g : formula) | T (p : Prop) (f : formula) | S (f : formula).
(* unwrap formula to prop *)
Fixpoint f2p (f : formula) : Prop :=
match f with
| I p => p
| A f g => f2p(f) /\ f2p(g)
| T p f => p -> f2p(f)
| _ => True
end.
Definition andl (l : list Prop) : Prop :=
fold_left and l True.
Variable x : nat.
Lemma test2:
let l := [I (x*x = 2)] in
~ exists a : nat,
let x := a in
andl (map f2p l).
Proof.
unfold andl. simpl.
Admitted.
But in this case, I can NOT see that a binds to x, after simpl..
1 subgoal
______________________________________(1/1)
~ (exists _ : nat, True /\ x * x = 2)
You cannot see it because it is not what happens.
You have expression
let x := a in andl (map f2p l)
which does define x to be a in andl (map f2p l) but this term does not mention x as you can see. It does mention another variable called x:
Variable x : nat.
but they are not the same!
When you write let x := a in exp you have a local definition x := a in the context of expression exp so you can write let x := a in x * x and it will reduce to a * a.
What you are trying to do is not do a local definition but instantiating a variable, the way this is done is by using function application.
let l := fun x => [I (x*x = 2)] in
~ exists a : nat,
let x := a in
andl (map f2p (l x)).
Related
The main problem is I cannot define such an Inductive proposition:
Inductive forces : nat -> Prop :=
| KM_cond (n : nat) : ~ forces 0 ->
forces n.
In fact, I am trying to define the Kripke Semantics for Intuitionistic Logic
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (~ forces M y A \/ forces M y B)) ->
forces M x (A then B).
but I get the following error
Non strictly positive occurrence of "forces"
If I just remove the negation, the problem goes away
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (forces M y A \/ forces M y B)) ->
forces M x (A then B).
but the problem exists with -> also
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (forces M y A -> forces M y B)) ->
forces M x (A then B).
I cannot understand what would possibly go wrong if I define this Inductive thing, and I cannot think of any other way to achieve this definition.
UPDATE:
These are the needed definitions:
From Coq Require Import Lists.List.
From Coq Require Import Lists.ListSet.
From Coq Require Import Relations.
Import ListNotations.
Definition var := nat.
Inductive prop : Type :=
| bot
| atom (p : var)
| conj (A B : prop)
| disj (A B : prop)
| cond (A B : prop).
Notation "A 'and' B" := (conj A B) (at level 50, left associativity).
Notation "A 'or' B" := (disj A B) (at level 50, left associativity).
Notation "A 'then' B" := (cond A B) (at level 60, no associativity).
Definition world := nat.
Definition preorder {X : Type} (R : relation X) : Prop :=
(forall x : X, R x x) /\ (forall x y z : X, R x y -> R y z -> R x z).
Inductive Kripke_model : Type :=
| Kripke (W : set world) (R : relation world) (v : var -> world -> bool)
(HW : W <> empty_set world)
(HR : preorder R)
(Hv : forall x y p, In x W -> In y W ->
R x y -> (v p x) = true -> (v p y) = true).
Definition worlds (M : Kripke_model) :=
match M with
| Kripke W _ _ _ _ _ => W
end.
Definition rel (M : Kripke_model) :=
match M with
| Kripke _ R _ _ _ _ => R
end.
Definition val (M : Kripke_model) :=
match M with
| Kripke _ _ v _ _ _ => v
end.
You cannot define this relation as an inductive predicate, but you can define it by recursion on the formula:
Fixpoint forces (M : Kripke_model) (x : world) (p : prop) : Prop :=
match p with
| bot => False
| atom p => val M p x = true
| conj p q => forces M x p /\ forces M x q
| disj p q => forces M x p \/ forces M x q
| cond p q => forall y, rel M x y -> forces M y p -> forces M y q
end.
This trick does not work if the definition is not well-founded with respect to the formula structure, but it might be enough for your use case.
I am trying to prove that given
(eqX : relation X) (Hypo : Equivalence eqX) (f : X -> {x : X | P x})
then
eqX a b -> eqX (proj1_sig (f a)) (proj1_sig (f b))
The function f get a parameter of Type X and give an existing assertion {x : X | P x}. ( for example fun (n : nat) => {m : nat | S m = n} )
In one word, I would like to show that given two parameters which are equivalent under the equivalent relation eqX, then the destruct result of existing assertion {x : X | P x} is also of the same equivalence class.
Can I prove this goal directly(which means the Specif.sig hold this property), or I should prove or claim that f satisfy some constraint and after which can I get this assertion proven.
Your claim is not directly provable; consider
X := nat
eqX a b := (a mod 2) = (b mod 2)
P a := True
f x := exist P (x / 2) I
Then we have eqX 2 4 but we don't have eqX (proj1_sig (f 2)) (proj1_sig (f 4)) because we don't have eqX 1 2.
You can either take in the theorem you are trying to prove as a hypothesis, or you can take in a hypothesis of type forall a, proj1_sig (f a) = a, or you can take in a hypothesis of type forall a, eqX (proj1_sig (f a)) a. Note that all of these are provable (by reflexivity or intros; assumption) if you have f a := exist P a (g a) for some function g.
Is this what you are trying to show?
Require Import Coq.Relations.Relation_Definitions.
Require Import Coq.Classes.Equivalence.
Require Import Setoid.
Generalizable All Variables.
Lemma foo `{!#Equivalence A RA, #Equivalence B RB, f : #respecting A _ _ B _ _ , #equiv A _ _ a b} :
equiv (proj1_sig f a) (proj1_sig f b).
Proof.
now apply respecting_equiv.
Qed.
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.
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.
I'm trying to use Function to define a recursive definition using a measure, and I'm getting the error:
Error: find_call_occs : Prod
I'm posting the whole source code at the bottom, but my function is
Function kripke_sat (M : kripke) (s : U) (p : formula) {measure size p}: Prop :=
match p with
| Proposition p' => L M (s)(p')
| Not p' => ~ kripke_sat M s p'
| And p' p'' => kripke_sat M s p' /\ kripke_sat M s p''
| Or p' p'' => kripke_sat M s p' \/ kripke_sat M s p''
| Implies p' p'' => ~kripke_sat M s p' \/ kripke_sat M s p''
| Knows a p' => forall t, ~(K M a) s t \/ kripke_sat M t p'
| EvKnows p' => forall i, kripke_sat M s (Knows i p' )
end.
I know the problem is due to the foralls: if I replace them with True, it works. I
also know I get the same error if my right-hand-side uses implications (->).
Fixpoint works with foralls, but doesn't allow me to define a measure.
Any advice?
As promised, my complete code is:
Module Belief.
Require Import Arith.EqNat.
Require Import Arith.Gt.
Require Import Arith.Plus.
Require Import Arith.Le.
Require Import Arith.Lt.
Require Import Logic.
Require Import Logic.Classical_Prop.
Require Import Init.Datatypes.
Require Import funind.Recdef.
(* Formalization of a variant of a logic of knowledge, as given in Halpern 1995 *)
Section Kripke.
Variable n : nat.
(* Universe of "worlds" *)
Definition U := nat.
(* Universe of Principals *)
Definition P := nat.
(* Universe of Atomic propositions *)
Definition A := nat.
Inductive prop : Type :=
| Atomic : A -> prop.
Definition beq_prop (p1 p2 :prop) : bool :=
match (p1,p2) with
| (Atomic p1', Atomic p2') => beq_nat p1' p2'
end.
Inductive actor : Type :=
| Id : P -> actor.
Definition beq_actor (a1 a2: actor) : bool :=
match (a1,a2) with
| (Id a1', Id a2') => beq_nat a1' a2'
end.
Inductive formula : Type :=
| Proposition : prop -> formula
| Not : formula -> formula
| And : formula -> formula -> formula
| Or : formula -> formula -> formula
| Implies : formula -> formula ->formula
| Knows : actor -> formula -> formula
| EvKnows : formula -> formula (*me*)
.
Inductive con : Type :=
| empty : con
| ext : con -> prop -> con.
Notation " C # P " := (ext C P) (at level 30).
Require Import Relations.
Record kripke : Type := mkKripke {
K : actor -> relation U;
K_equiv: forall y, equivalence _ (K y);
L : U -> (prop -> Prop)
}.
Fixpoint max (a b: nat) : nat :=
match a, b with
| 0, _ => a
| _, 0 => b
| S(a'), S(b') => 1 + max a' b'
end.
Fixpoint length (p: formula) : nat :=
match p with
| Proposition p' => 1
| Not p' => 1 + length(p')
| And p' p'' => 1 + max (length p') (length p'')
| Or p' p'' => 1 + max (length p') (length p'')
| Implies p' p'' => 1 + max (length p') (length p'')
| Knows a p' => 1 + length(p')
| EvKnows p' => 1 + length(p')
end.
Fixpoint numKnows (p: formula): nat :=
match p with
| Proposition p' => 0
| Not p' => 0 + numKnows(p')
| And p' p'' => 0 + max (numKnows p') (numKnows p'')
| Or p' p'' => 0 + max (numKnows p') (numKnows p'')
| Implies p' p'' => 0 + max (numKnows p') (numKnows p'')
| Knows a p' => 0 + numKnows(p')
| EvKnows p' => 1 + numKnows(p')
end.
Definition size (p: formula): nat :=
(numKnows p) + (length p).
Definition twice (n: nat) : nat :=
n + n.
Theorem duh: forall a: nat, 1 + a > a.
Proof. induction a. apply gt_Sn_O.
apply gt_n_S in IHa. unfold plus in *. apply IHa. Qed.
Theorem eq_lt_lt: forall (a b c d: nat), a = b -> c<d -> a+ c< b+d.
Proof. intros. apply plus_le_lt_compat.
apply eq_nat_elim with (n:=a) (m := b). apply le_refl.
apply eq_nat_is_eq. apply H. apply H0. Qed.
Function kripke_sat (M : kripke) (s : U) (p : formula) {measure size p}: Prop :=
match p with
| Proposition p' => L M (s)(p')
| Not p' => ~ kripke_sat M s p'
| And p' p'' => kripke_sat M s p' /\ kripke_sat M s p''
| Or p' p'' => kripke_sat M s p' \/ kripke_sat M s p''
| Implies p' p'' => ~kripke_sat M s p' \/ kripke_sat M s p''
| Knows a p' => forall t, ~(K M a) s t \/ kripke_sat M t p'
| EvKnows p' => forall i, kripke_sat M s (Knows i p' )
end.
The "Function" plugin is still very experimental.
In the documentation you can find
term0 must be build as a pure pattern-matching tree (match...with) with λ-abstractions and applications only at the end of each branch.
But I have to agree that this error message is far from being explicit
(normally such error messages should either end with "Please report" or be more user
friendly, I consider this as a bug). It means foralls are not allowed in the body of a Function (I don't know whether or not there are theoretical reasons for this behavior).
So you need to do your definition "by hand" without the help of
Function. Here is a small example you can adapt for your development.
Good luck !
Inductive form : Set :=
| T : form
| K : nat -> form -> form
| eK : form -> form.
Fixpoint size (f : form) : nat := match f with
| T => 1
| K _ f => S (size f)
| eK f => S (S (size f))
end.
Require Import Wf.
Require Import Wf_nat.
Definition R x y := size x < size y.
Lemma R_wf : well_founded R.
apply well_founded_ltof.
Qed.
Lemma lem1 :
forall x n, R x (K n x).
unfold R; intuition.
Qed.
Lemma lem2 :
forall x n, R (K n x) (eK x).
unfold R; intuition.
Qed.
Definition interpret : form -> Prop.
(* we use the well_founded_induction instead of Function *)
refine (well_founded_induction_type R_wf (fun _ => Prop) (fun x f => _)).
destruct x.
exact True. (* ⟦T⟧ ≡ True *)
exact (n = 2 /\ f x (lem1 x n)). (* ⟦K n F⟧ ≡ (n = 2) ∧ ⟦F⟧ *)
exact (forall n:nat, f (K n x) (lem2 x n)). (* ⟦eK F⟧ ≡ ∀n:nat,⟦K n F⟧ *)
Defined.
PS: I am going to fill a bug report with the following simpler version of your code.
Require Import Recdef.
Inductive I : Set :=
| C : I.
Definition m (_ : I) := 0.
Function f (x : I) {measure m x} : Type := match x with
| C => nat -> nat end.
The error message has changed in Coq 8.4 but the problem is still there. The new error message is: "Error: Found a product. Can not treat such a term"
This change in error message also lead to Marc's bug being closed:
http://www.lix.polytechnique.fr/coq/bugs/show_bug.cgi?id=2457