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
Related
Task: write a function to convert natural numbers to binary numbers.
Inductive bin : Type :=
| Z
| A (n : bin)
| B (n : bin).
(* Division by 2. Returns (quotient, remainder) *)
Fixpoint div2_aux (n accum : nat) : (nat * nat) :=
match n with
| O => (accum, O)
| S O => (accum, S O)
| S (S n') => div2_aux n' (S accum)
end.
Fixpoint nat_to_bin (n: nat) : bin :=
let (q, r) := (div2_aux n 0) in
match q, r with
| O, O => Z
| O, 1 => B Z
| _, O => A (nat_to_bin q)
| _, _ => B (nat_to_bin q)
end.
The 2-nd function gives an error, because it is not structurally recursive:
Recursive call to nat_to_bin has principal argument equal to
"q" instead of a subterm of "n".
What should I do to prove that it always terminates because q is always less then n.
Prove that q is (almost always) less than n:
(* This condition is sufficient, but a "better" one is n <> 0
That makes the actual function slightly more complicated, though *)
Theorem div2_aux_lt {n} (prf : fst (div2_aux n 0) <> 0) : fst (div2_aux n 0) < n.
(* The proof is somewhat involved...
I did it by proving
forall n k, n <> 0 ->
fst (div2_aux n k) < n + k /\ fst (div2_aux (S n) k) < S n + k
by induction on n first *)
Then proceed by well-founded induction on lt:
Require Import Arith.Wf_nat.
Definition nat_to_bin (n : nat) : bin :=
lt_wf_rec (* Recurse down a chain of lts instead of structurally *)
n (fun _ => bin) (* Starting from n and building a bin *)
(fun n rec => (* At each step, we have (n : nat) and (rec : forall m, m < n -> bin) *)
match div2_aux n 0 as qr return (fst qr <> 0 -> fst qr < n) -> _ with (* Take div2_aux_lt as an argument; within the match the (div2_aux_lt n 0) in its type is rewritten in terms of the matched variables *)
| (O, r) => fun _ => if r then Z else B Z (* Commoning up cases for brevity *)
| (S _ as q, r) => (* note: O is "true" and S _ is "false" *)
fun prf => (if r then A else B) (rec q (prf ltac:(discriminate)))
end div2_aux_lt).
I might suggest making div2_aux return nat * bool.
Alternatively, Program Fixpoint supports these kinds of induction, too:
Require Import Program.
(* I don't like the automatic introing in program_simpl and
now/easy can solve some of our obligations. *)
#[local] Obligation Tactic := (now program_simpl) + cbv zeta.
(* {measure n} is short for {measure n lt}, which can replace the
core language {struct arg} when in a Program Fixpoint
(n can be any expression and lt can be any well-founded relation
on the type of that expression) *)
#[program] Fixpoint nat_to_bin (n : nat) {measure n} : bin :=
match div2_aux n 0 with
| (O, O) => Z
| (O, _) => B Z
| (q, O) => A (nat_to_bin q)
| (q, _) => B (nat_to_bin q)
end.
Next Obligation.
intros n _ q [_ mem] prf%(f_equal fst).
simpl in *.
subst.
apply div2_aux_lt.
auto.
Defined.
Next Obligation.
intros n _ q r [mem _] prf%(f_equal fst).
specialize (mem r).
simpl in *.
subst.
apply div2_aux_lt.
auto.
Defined.
I have function,whose output is some natural number.I have proved a lemma,that output of this function cannot be zero. It means output is equal to some natural number S m.I want to convert the above lemma.
Theorem greater:forall (m :nat)(l:list nat),
m=?0=false ->
0=? (f1 + m)=false->
(f1 + m)= S m.
The statement you entered does not type check. Regardless, I don't see how it could hold -- for instance, if by l you mean f1 : nat, then the statement would imply that 3 = 2.
Require Import Coq.Arith.Arith.
Theorem greater:forall (m :nat)(f1:nat),
m=?0=false ->
0=? (f1 + m)=false->
(f1 + m)= S m.
Admitted.
Lemma contra : False.
Proof.
pose proof (greater 1 2 eq_refl eq_refl).
easy.
Qed.
Proving that something that is not zero is a successor can be done as follows:
Require Import Coq.Arith.Arith.
Lemma not_zero_succ :
forall n, n <> 0 ->
exists m, n = S m.
Proof. destruct n as [|n]; eauto; easy. Qed.
Edit The complete statement you wrote below is also contradictory:
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.
Import ListNotations.
Fixpoint lt_numb (n: nat) (l: list nat) : nat :=
match l with
| nil => 0
| h::tl =>
if h <? n then S (lt_numb n tl) else lt_numb n tl
end.
Fixpoint greatest (large: nat) (l: list nat) : nat :=
match large with
| O => 0
| S m' => (lt_numb large l) + (greatest m' l)
end.
Definition change (n: nat) (l: list nat) : list nat :=
match l with
| nil => l
| h::tl => if n <? h then l else n::tl
end.
Fixpoint g_value (elements: nat) (l: list nat) : nat :=
match l with
| nil => 0
| [n] => n
| h :: l =>
match elements with
| O => h
| S elements' => g_value elements' (change h l)
end
end.
Theorem no_elements : forall (m n z :nat)(l:list nat),
m=?0=false -> greatest(g_value (length (n :: l)) (n :: l) + m) (n :: l) = (S z).
Proof. Admitted.
Goal False.
pose proof (no_elements 1 0 1 [] eq_refl).
simpl in H.
discriminate.
Qed.
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.
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.
The following code (which is of course not a complete proof) tries to do pattern matching on a dependent product:
Record fail : Set :=
mkFail {
i : nat ;
f : forall x, x < i -> nat
}.
Definition failomat : forall (m : nat) (f : forall x, x < m -> nat), nat.
Proof.
intros.
apply 0.
Qed.
Function fail_hard_omat fl : nat := failomat (i fl) (f fl).
Definition failhard fl : fail_hard_omat fl = 0.
refine ((fun fl =>
match fl with
| mkFail 0 _ => _
| mkFail (S n) _ => _
end) fl).
The error I get when trying to execute this is
Toplevel input, characters 0-125:
Error: Illegal application (Type Error):
The term "mkFail" of type
"forall i : nat, (forall x : nat, x < i -> nat) -> fail"
cannot be applied to the terms
"i" : "nat"
"f0" : "forall x : nat, x < i0 -> nat"
The 2nd term has type "forall x : nat, x < i0 -> nat"
which should be coercible to "forall x : nat, x < i -> nat".
It seems that the substitution somehow does not reach the inner type parameters.
After playing with the Program command I managed to build a refine that might suites you, but I don't understand everything I did. The main idea is to help Coq with the substitution by introducing intermediate equalities that will serve as brige within the substitution
refine ((fun fl =>
match fl as fl0 return (fl0 = fl -> fail_hard_omat fl0 = 0) with
| mkFail n bar =>
match n as n0 return (forall foo: (forall x:nat, x < n0 -> nat),
mkFail n0 foo = fl -> fail_hard_omat (mkFail n0 foo) = 0) with
| O => _
| S p => _
end bar
end (eq_refl fl) ) fl).
Anyway, I don't know what your purpose here is, but I advise never write dependent match "by hand" and rely on Coq's tactics. In your case, if you define your Definition failomat with Defined. instead of Qed, you will be able to unfold it and you won't need dependent matching.
Hope it helps,
V.
Note: both occurences of bar can be replaced by an underscore.
Another, slightly less involved, alternative is to use nat and fail's induction combinators.
Print nat_rect.
Print fail_rect.
Definition failhard : forall fl, fail_hard_omat fl = 0.
Proof.
refine (fail_rect _ _). (* Performs induction (projection) on fl. *)
refine (nat_rect _ _ _). (* Performs induction on fl's first component. *)
Show Proof.