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
Related
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.
I'm modeling a program in which users can choose from different operators and functions for writing queries (i.e. formulas) for the system. For showing these operators, here I defined add and mul functions and used nat datatype, instead of my program's functions and datatypes. How should I define formula that enables me to use it in definition compute_formula. I'm a bit stuck at solving this issue. Thank you.
Fixpoint add n m :=
match n with
| 0 => m
| S p => S (p + m)
end
where "n + m" := (add n m) : nat_scope.
Fixpoint mul n m :=
match n with
| 0 => 0
| S p => m + p * m
end
where "n * m" := (mul n m) : nat_scope.
Definition formula : Set :=
nat-> nat -> ?operators_add_mull ->formula.
Definition compute_formula (f: formula) : nat :=
match f with
|firstnumber,secondnumber, ?operators_add_mull =>
?operators_add_mull firstnumber secondnumber
end.
First, your syntax for defining a data type is not quite right: you need to use the Inductive keyword:
Inductive formula : Set :=
| Formula : nat -> nat -> ?operators_add_mul -> formula.
It remains to figure out what the arguments to the Formula constructor should be. The Coq function type -> is a type like any other, and we can use it as the third argument:
Inductive formula : Set :=
| Formula : nat -> nat -> (nat -> nat -> nat) -> formula.
After defining this data type, you can write an expression like Formula 3 5 add, which denotes the addition of 3 and 5. To inspect the formula data type, you need to write match using the Formula constructor:
Definition compute_formula (f : formula) : nat :=
match f with
| Formula n m f => f n m
end.
Is there a way to use recursion with Coq's typeclasses? Like for e.g., in defining show for lists, if you want to call the show function for lists recursively, then you will have to use a fixpoint like so:
Require Import Strings.String.
Require Import Strings.Ascii.
Local Open Scope string_scope.
Class Show (A : Type) : Type :=
{
show : A -> string
}.
Section showNormal.
Instance showList {A : Type} `{Show A} : Show (list A) :=
{
show :=
fix lshow l :=
match l with
| nil => "[]"
| x :: xs => show x ++ " : " ++ lshow xs
end
}.
End showNormal.
Which is all well and good, but what if I want to define some helper function that I'll use for defining Show instances? Like I want to create a more DAZZLING show function called magicShow that prints stars around something...
Definition magicShow {A : Type} `{Show A} (a : A) : string :=
"** " ++ show a ++ " **".
Instance showMagicList {A : Type} `{Show A} : Show (list A) :=
{
show :=
fix lshow l :=
match l with
| nil => "[]"
| x :: xs => show x ++ " : " ++ magicShow xs
end
}.
However, in this case Coq can't find a show instance for the list xs to pass to magicShow:
Error:
Unable to satisfy the following constraints:
In environment:
A : Type
H : Show A
lshow : list A -> string
l : list A
x : A
xs : list A
?H : "Show (list A)"
Is there any way to do this in general? I.e., can you define a method for a typeclass using functions that rely upon the typeclass instance that you're defining?
No, there's no way to do this. This works in Haskell because arbitrary recursive bindings are allowed, and the language doesn't care about the order of bindings. Coq is more restrictive on both fronts. This makes sense if you think about what the desugaring looks like: the recursive call to show would refer to the currently-being-defined instance by name, but that binding isn't in scope yet. And you can't make the instance itself a fixpoint because you're recursing on the structure of a type, not on a value of an algebraic data type.
Your inline fixpoint works for show, but the problem gets thornier if your method implementations refer to each other, such as
newtype MyInteger = MyInteger Integer
instance Num MyInteger where
MyInteger m + MyInteger n = MyInteger $ m + n
negate (MyInteger m) = MyInteger $ negate m
m - n = m + negate n
-- other methods
Here, the calls to (+) and negate in the definition of (-) needs to refer to the definitions of (+) and negate above, but this also doesn't work in Coq. The only solution is to define all your methods separately, manually referencing each other, and then define the instance simply by setting each method to the one you defined above. For example,
Inductive MyInteger := Mk_MyInteger : Integer -> MyInteger.
Definition add__MyInteger (m n : MyInteger) : MyInteger :=
let 'Mk_MyInteger m' := m in
let 'Mk_MyInteger n' := n in
Mk_MyInteger (add m' n').
Definition negate__MyInteger (m : MyInteger) : MyInteger :=
let 'Mk_MyInteger m' := m in
Mk_MyInteger (negate m').
Definition sub__MyInteger (m n : MyInteger) : MyInteger :=
add__MyInteger m (negate__MyInteger n).
Instance Num__MyInteger : Num MyInteger := {|
add := add__MyInteger;
negate := negate__MyInteger;
sub := sub__MyInteger;
(* other methods *)
|}.
If you must do this, it can be simulated by explicitly using the constructor of the underlying Record (since "Typeclasses are Records", to quote from Software Foundations [1]), which can be instantiated using the function(s) being defined as a fixpoint. I'll post three examples and explain where this can be useful.
The example you posted could be solved like this (all code tested for Coq 8.10.1):
Require Import Strings.String.
Local Open Scope list_scope.
Local Open Scope string_scope.
Class Show (A : Type) : Type :=
{
show : A -> string
}.
Definition magicShow {A : Type} `{Show A} (a : A) : string :=
"** " ++ show a ++ " **".
Print Show.
(* Record Show (A : Type) : Type := Build_Show { show : A -> string }
*)
Check Build_Show.
(* Build_Show : forall A : Type, (A -> string) -> Show A *)
Check #magicShow.
(* #magicShow : forall A : Type, Show A -> A -> string *)
Instance showMagicList {A : Type} `{Show A} : Show (list A) :=
{
show :=
fix lshow l :=
match l with
| nil => "[]"
| x :: xs => show x ++ " : " ++ #magicShow _ (#Build_Show _ lshow) xs
end
}.
If you are trying to define several typeclass methods like this, it's tricky to instantiate the record constructor, but it can be done by treating the functions as if they were defined by mutual recursion (although there doesn't necessarily have to be any actual mutual recursion). Here's a contrived example where Show now has two methods. Notice that the typeclass instance is added to the context with an anonymous let-in binding. Evidently, this is enough to satisfy Coq's typeclass resolution mechanism.
Require Import Strings.String.
Local Open Scope list_scope.
Local Open Scope string_scope.
Class Show (A : Type) : Type :=
{
show1 : A -> string
; show2 : A -> string
}.
Definition magicShow1 {A : Type} `{Show A} (a : A) : string :=
"** " ++ show1 a ++ " **".
Definition magicShow2 {A : Type} `{Show A} (a : A) : string :=
"** " ++ show2 a ++ " **".
Fixpoint show1__list {A : Type} `{Show A} (l : list A) : string :=
let _ := (#Build_Show _ show1__list show2__list) in
match l with
| nil => "[]"
| x :: xs => show1 x ++ " : " ++ magicShow1 xs
end
with show2__list {A : Type} `{Show A} (l : list A) : string :=
let _ := (#Build_Show _ show1__list show2__list) in
match l with
| nil => "[]"
| x :: xs => show1 x ++ " : " ++ magicShow2 xs
end.
Instance showMagicList {A : Type} `{Show A} : Show (list A) :=
{
show1 := show1__list
; show2 := show2__list
}.
So why would you want to do this? A good example is when you are defining decidable equality on (rose) trees. In the middle of the definition, we have to recursively appeal to decidable equality of list (tree A). We would like to use the standard library helper function Coq.Classes.EquivDec.list_eqdec [2], which shows how to pass decidable equality on a type A to list A. Since list_eqdec requires a typeclass instance (the very one we are in the middle of defining), we have to use the same trick above:
Require Import Coq.Classes.EquivDec.
Require Import Coq.Program.Utils.
Set Implicit Arguments.
Generalizable Variables A.
Inductive tree (A : Type) : Type :=
| leaf : A -> tree A
| node : list (tree A) -> tree A.
Program Instance tree_eqdec `(eqa : EqDec A eq) : EqDec (tree A) eq :=
{ equiv_dec := fix tequiv t1 t2 :=
let _ := list_eqdec tequiv in
match t1, t2 with
| leaf a1, leaf a2 =>
if a1 == a2 then in_left else in_right
| node ts1, node ts2 =>
if ts1 == ts2 then in_left else in_right
| _, _ => in_right
end
}.
Solve Obligations with unfold not, equiv, complement in * ;
program_simpl ; intuition (discriminate || eauto).
Next Obligation.
destruct t1;
destruct t2;
( program_simpl || unfold complement, not, equiv in *; eauto ).
Qed.
Solve Obligations with split; (intros; try unfold complement, equiv ; program_simpl).
(*
No more obligations remaining
tree_eqdec is defined
*)
Commentary: There is no constructor for creating a record of type EqDec (since it only has one class method), so to convince Coq that list (tree A) has decidable equality, the invocation is simply list_eqdec tequiv. For the uninitiated, Program here is simply allowing for holes in the definition of the instance to be filled in later as Obligations, which is more convenient than writing the appropriate proofs inline.
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.
I've been using Coq for a very short time and I still bump into walls with some things. I've defined a set with a Record construction. Now I need to do some pattern matching to use it, but I'm having issues properly using it. First, these are my elements.
Inductive element : Set :=
| empty : element
.
.
.
| fun_m : element -> element -> element
| n_fun : nat -> element -> element
.
I pick the elements with certain characteristic to make a subset of them the next way:
Inductive esp_char : elements -> Prop :=
| esp1 : esp_char empty
| esp2 : forall (n : nat )(E : element), esp_char E -> esp_char (n_fun n E).
Record especial : Set := mk_esp{ E : element ; C : (esp_char E)}.
Now, I need to use definition and fix point on the 'especial' elements, just the two that I picked. I have read the documentation on Record and what I get is that I'd need to do something like this:
Fixpoint Size (E : especial): nat :=
match E with
|{|E := empty |} => 0
|{|E := n_fun n E0|} => (Size E0) + 1
end.
Of course this tells me that I'm missing everything on the inductive part of elements so I add {|E := _ |}=> 0, or anything, just to make the induction full. Even doing this, I then find this problem:
|{|E := n_fun n E0|} => (Size E0) + 1
Error:
In environment
Size : especial -> nat
E : especial
f : element
i : esp_char f
n : nat
E0 : element
The term "E0" has type "element" while it is expected to have type "especial".
What I have been unable to do is fix that last thing, I have a lemma proving that if n_fun n E0 is 'especial' then E0 is especial, but I can't build it as so inside the Fixpoint. I also defined the size for "all elements" and then just picked the "especial" ones in a definition, but I want to be able to do direct pattern matching directly on the set "especial". Thank you for your input.
EDIT: Forgot to mention that I also have a coercion to always send especial to elements.
EDIT: This is the approach I had before posting:
Fixpoint ElementSize (E : element): nat :=
match E with
| n_fun n E0 => (ElementSize E0) + 1
| _ => 0
end.
Definition Size (E : especial) := ElementSize E.
I'd have tried to do:
Lemma mk_especial_proof n E : esp_char (n_fun n E) -> esp_char E.
Proof. now intros U; inversion U. Qed.
Fixpoint Size (E : especial): nat :=
match E with
|{|E := empty |} => 0
|{|E := n_fun n E0; C := P |} => (Size (mk_esp E0 (mk_especial_proof _ _ P))) + 1
|{|E := fun_m E1 E2 |} => 0
end.
However this will fail the termination check. I'm not familiar with how to overcome this problem with records. I'd definitively follow the approach I mentioned in the comments (using a fixpoint over the base datatype).
EDIT: Added single fixpoint solution.
Fixpoint size_e e :=
match e with
| empty => 0
| fun_m e1 e2 => 0
| n_fun _ e => 1 + size_e e
end.
Definition size_esp e := size_e (E e).
I reduced your example to this, but you can easily go back to your definition. We have a set, and a subset defined by an inductive predicate. Often one uses sigma types for this, with the notation {b | Small b}, but it is actually the same as the Record definition used in your example, so never mind :-).
Inductive Big : Set := (* a big set *)
| A
| B (b0 b1:Big)
| C (b: Big).
Inductive Small : Big -> Prop := (* a subset *)
| A' : Small A
| C' (b:Big) : Small b -> Small (C b).
Record small := mk_small { b:Big ; P:Small b }.
Here is a solution.
Lemma Small_lemma: forall b, Small (C b) -> Small b.
Proof. intros b H; now inversion H. Qed.
Fixpoint size (b : Big) : Small b -> nat :=
match b with
| A => fun _ => 0
| B _ _ => fun _ => 0
| C b' => fun H => 1 + size b' (Small_lemma _ H)
end.
Definition Size (s:small) : nat :=
let (b,H) := s in size b H.
To be able to use the hypothesis H in the match-branches, it is sent into the branch as a function argument. Otherwise the destruction of b is not performed on the H term, and Coq can't prove that we do a structural recursion on H.