Mutualy recursive function and termination checker in Coq - coq

EDIT
Require Import Bool List ZArith.
Variable A: Type.
Inductive error :=
| Todo.
Inductive result (A : Type) : Type :=
Ok : A -> result A | Ko : error -> result A.
Variable bool_of_result : result A -> bool.
Variable rules : Type.
Variable boolean : Type.
Variable positiveInteger : Type.
Variable OK: result unit.
Definition dps := rules.
Inductive dpProof :=
| DpProof_depGraphProc : list
(dps * boolean * option (list positiveInteger) * option dpProof) -> dpProof.
Fixpoint dpProof' (R D: rules) (p: dpProof) {struct p}:=
match p with
| DpProof_depGraphProc cs => dpGraphProc R D cs
end
with dpGraphProc (R D: rules ) cs {struct cs} :=
match cs with
| nil => Ko unit Todo
| (_, _, _, op) :: cs' =>
match op with
| None => Ko unit Todo
| Some p2 => dpProof' R D p2
end
end.
I got an error message saying that:
Recursive call to dpProof has principal argument equal to
"p2" instead of "cs'".
Recursive definition is:
"fun (R D : rules)
(cs : list
(dps * boolean * option (list positiveInteger) *
option dpProof)) =>
match cs with
| nil => Ko unit Todo
| (_, _, _, Some p2) :: _ => dpProof' R D p2
| (_, _, _, None) :: _ => OK
end".
If I do not use the mutual recursive and use the nested fixpoint, it will combine and pass the checker of termination. Here is the code that successfully combined.
Fixpoint dpProof' (R D: rules) (p: dpProof) {struct p}:=
match p with
| DpProof_depGraphProc cs =>
match cs with
| nil => Ko _ Todo
| (_, _, _, op) :: cs' =>
match op with
| None => Ko unit Todo
| Some p2 => dpProof' R D p2
end
end end.
I would like to understand deeper about the reason why it cannot pass the termination checker? Is it because they cannot guess the argument descreasing? Is there any way that I can use the mutually recursive to express my function dpGraphProc?
Also How can I write the function dpGraphProc that check in the whole list? Here I do not know how to use the argument cs'.

Mutual recursion is to be used either with a single inductive data-type or with different inductive data-types that have been defined together in a single inductive definition. In your case, you are using polymorphic data-types prod (the type of pairs), list, and option which were already defined before dpProof.
The nested fixpoint approach does not have the restriction.

Related

Instance of Ord typeclass for option

In volume 4 of Software foundations "QuickChick" we have the following excercise:
Class Ord A `{Eq A} : Type :=
{
le : A -> A -> bool
}.
(* Define [Ord] instances for options and pairs. *)
(* So I am trying to do it *)
Instance optionOrd {A : Type} `{Ord A} `{Eq (option A)} : Ord (option A) :=
{
le := fun (opt1 opt2 : option A) =>
match opt1 with
| None => match opt2 with
| None => true
| Some a => true
end
| Some a1 => match opt2 with
| None => false
| Some a2 => le a1 a2
end
end.
}.
But get an error:
Error: Syntax error: '}' expected after [constr:record_declaration]
(in [vernac:gallina_ext]).
And it highlights match opt1 with.
Maybe, my solution is quite primitive: it just pattern matches all possible cases. Is there anything better?
What causes this syntax error?
Just remove the . after the last end.

Program Fixpoint error with Admit Obligations and nested recursion

I was trying to define a function using Program Fixpoint, which uses another (anonymous) recursive function in its body. I tried using Admit Obligationsfor the moment, to see if something else made sense but I get an error.
This is a simple example that shows the same error (maybe there is a simpler one...).
Require Import List.
Import ListNotations.
Require Import Program.
Section Test.
Inductive FType : Type :=
| Base : RType -> FType
| Cons : RType -> FType -> FType
with RType : Type :=
| Empty : RType
| Nested : nat -> FType -> RType
| NestedList : nat -> list FType -> RType.
Variable ftype_size : FType -> nat.
Program Fixpoint failing (ft : FType) {measure (ftype_size ft)} : FType :=
match ft with
| Base _ => ft
| Cons hd tl =>
match hd with
| NestedList l rs =>
let fix loop (rs : list FType) (i : nat) : list FType :=
match rs with
| [] => []
| r' :: rs' => (failing r') :: (loop rs' (i + 1))
end
in
Base (NestedList l (loop rs 0))
| _ => ft
end
end.
Admit Obligations.
End Test.
So, when running this it says Recursive call to loop has not enough arguments.. I was wondering why is this happening? Is it somehow related to this issue?
Also, if I define an indexed map and repeat this, I don't get any error.
Section Map.
Variables (T1 T2 : Type) (f : nat -> T1 -> T2).
Definition indexed_map (s : list T1) :=
let fix imap s index : list T2 :=
match s with
| [] => []
| hd :: tl => (f index hd) :: imap tl (index + 1)
end
in
imap s 0.
End Map.
Arguments indexed_map [T1 T2].
Program Fixpoint failing (ft : FType) {measure (ftype_size ft)} : FType :=
match ft with
| Base _ => ft
| Cons hd tl =>
match hd with
| NestedList l rs => Base (NestedList l (indexed_map (fun i r' => (failing r')) rs))
| _ => ft
end
end.
Admit Obligations.
I can probably define it in a different way but I was still wondering why is this happening.
Reading the error message further, notice that loop occurs twice in the printed function. The second occurence is the one you wrote, but the first (the problematic one) is an argument to an axiom generated by Admit Obligations.
Recursive call to loop has not enough arguments.
Recursive definition is:
"fun (rs0 : list FType) (i : nat) =>
let program_branch_0 := fun _ : [] = rs0 => [] in
let program_branch_1 :=
fun (r' : FType) (rs' : list FType) (Heq_rs : r' :: rs' = rs0) =>
failing r'
(failing_obligation_1 ft failing hd tl Heq_ft l rs Heq_hd loop
rs0 i r' rs' Heq_rs) :: loop rs' (i + 1) in
match rs0 as rs' return (rs' = rs0 -> list FType) with
| [] => program_branch_0
| r' :: rs' => program_branch_1 r' rs'
end eq_refl".
To avoid that, you can step through the corresponding obligation manually and put your own axiom that doesn't depend on loop.
Parameter TODO : forall {A : Prop}, A.
Program Fixpoint failing ... (* Your definition *)
Next Obligation.
apply TODO.
Qed.
(* Now the rest can still be Admitted. *)
Admit Obligations.

How can I match on a specific value in Coq?

I'm trying to implement a function that simply counts the number of occurrences of some nat in a bag (just a synonym for a list).
This is what I want to do, but it doesn't work:
Require Import Coq.Lists.List.
Import ListNotations.
Definition bag := list nat.
Fixpoint count (v:nat) (s:bag) : nat :=
match s with
| nil => O
| v :: t => S (count v t)
| _ :: t => count v t
end.
Coq says that the final clause is redundant, i.e., it just treats v as a name for the head instead of the specific v that is passed to the call of count. Is there any way to pattern match on values passed as function arguments? If not, how should I instead write the function?
I got this to work:
Fixpoint count (v:nat) (s:bag) : nat :=
match s with
| nil => O
| h :: t => if (beq_nat v h) then S (count v t) else count v t
end.
But I don't like it. I'd rather pattern match if possible.
Pattern matching is a different construction from equality, meant to discriminate data encoded in form of "inductives", as standard in functional programming.
In particular, pattern matching falls short in many cases, such as when you need potentially infinite patterns.
That being said, a more sensible type for count is the one available in the math-comp library:
count : forall T : Type, pred T -> seq T -> nat
Fixpoint count s := if s is x :: s' then a x + count s' else 0.
You can then build your function as count (pred1 x) where pred1 : forall T : eqType, T -> pred T , that is to say, the unary equality predicate for a fixed element of a type with decidable (computable) equality; pred1 x y <-> x = y.
I found in another exercise that it's OK to open up a match clause on the output of a function. In that case, it was "evenb" from "Basics". In this case, try "eqb".
Well, as v doesn't work in the match, I thought that maybe I could ask whether the head of the list was equal to v. And yes, it worked. This is the code:
Fixpoint count (v : nat) (s : bag) : nat :=
match s with
| nil => 0
| x :: t =>
match x =? v with
| true => S ( count v t )
| false => count v t
end
end.

How to pattern match on a Prop when proving in Coq without elimination on Type

I'm trying to prove that the tail of a sorted list is sorted in Coq, using pattern matching instead of tactics:
Require Import Coq.Sorting.Sorted.
Definition tail_also_sorted {A : Prop} {R : relation A} {h : A} {t : list A}
(H: Sorted R (h::t)) : Sorted R t :=
match H in Sorted _ (h::t) return Sorted _ t with
| Sorted_nil _ => Sorted_nil R
| Sorted_cons rest_sorted _ => rest_sorted
end.
This fails however, with:
Error:
Incorrect elimination of "H" in the inductive type "Sorted":
the return type has sort "Type" while it should be "Prop".
Elimination of an inductive object of sort Prop
is not allowed on a predicate in sort Type
because proofs can be eliminated only to build proofs.
I suspect it's possible in the underlying Calculus, as the following Lean code type-checks, and Lean is also built upon the CIC:
inductive is_sorted {α: Type} [decidable_linear_order α] : list α -> Prop
| is_sorted_zero : is_sorted []
| is_sorted_one : ∀ (x: α), is_sorted [x]
| is_sorted_many : ∀ {x y: α} {ys: list α}, x < y -> is_sorted (y::ys) -> is_sorted (x::y::ys)
lemma tail_also_sorted {α: Type} [decidable_linear_order α] : ∀ {h: α} {t: list α},
is_sorted (h::t) -> is_sorted t
| _ [] _ := is_sorted.is_sorted_zero
| _ (y::ys) (is_sorted.is_sorted_many _ rest_sorted) := rest_sorted
This seems like a bug. The problem, I think, is in the following part:
in Sorted _ (h::t)
In pure CIC, this kind of annotation on match expressions is not allowed. Instead, you are required to write something like this:
Definition tail_also_sorted {A : Prop} {R : relation A} {h : A} {t : list A}
(H: Sorted R (h::t)) : Sorted R t :=
match H in Sorted _ t'
return match t' return Prop with
| [] => True
| h :: t => Sorted R t
end with
| Sorted_nil _ => I
| Sorted_cons rest_sorted _ => rest_sorted
end.
The difference is that the index in the in clause is now a fresh variable that is bound in the return clause. To relieve you from having to write such horrible programs, Coq allows you to put slightly more complicated expressions in in clauses than generic variables, like the one you had. To avoid compromising soundness, this extension is actually compiled down to core CIC terms. I imagine that there is a bug somewhere is this translation that is producing the following term instead:
Definition tail_also_sorted {A : Prop} {R : relation A} {h : A} {t : list A}
(H: Sorted R (h::t)) : Sorted R t :=
match H in Sorted _ t'
return match t' return Type with
| [] => True
| h :: t => Sorted R t
end with
| Sorted_nil _ => I
| Sorted_cons rest_sorted _ => rest_sorted
end.
Notice the return Type annotation. Indeed, if you try to enter this snippet in Coq, you get exactly the same error message as the one you saw.

Proving Termination in Coq

How can I prove termination for size_prgm? I tried, but can't come up with a well founded relation to pass to Fix.
Inductive Stmt : Set :=
| assign: Stmt
| if': (list Stmt) -> (list Stmt) -> Stmt.
Fixpoint size_prgm (p: list Stmt) : nat :=
match p with
| nil => 0
| s::t => size_prgm t +
match s with
| assign => 1
| if' b0 b1 => S (size_prgm b0 + size_prgm b1)
end
end.
The termination oracle is quite better than what it used to be. Defining a function sum_with using fold_left and feeding it the recursive call to size_prgm works perfectly well.
Require Import List.
Inductive Stmt : Set :=
| assign: Stmt
| if': (list Stmt) -> (list Stmt) -> Stmt.
Definition sum_with {A : Type} (f : A -> nat) (xs : list A) : nat :=
fold_left (fun n a => n + f a) xs 0.
Fixpoint size_prgm (p: Stmt) : nat :=
match p with
| assign => 1
| if' b0 b1 => sum_with size_prgm b1 + sum_with size_prgm b0
end.
Short answer, since I don't have much time right now (I'll try to get back to you later):
this is a really usual (and silly) problem that every Coq user has to experience one day.
If I recall correctly, there is two "general" solutions to this problem and lots of very specific ones. For the two former:
build a inner fixpoint: I don't really remember how to do this properly.
use a mutual recursive type: The issue with your code is that you use list Stmt in your Stmt type, and Coq is not able to compute the induction principle you have in mind. But you could use a time like
Inductive Stmt : Set :=
| assign : Stmt
| if': list_Stmt -> list_Stmt -> Stmt
with list_Stmt : Set :=
| Nil_Stmt : list_Stmt
| Cons_Stmt : Stmt -> list_Stmt -> list_Stmt.
Now write your function over this type and a bijection between this type and your original Stmt type.
You can try to browse the Coq-Club mailing list, this kind of topic is a recurring one.
Hope it helps a bit,
V