I have the following GADT.
Inductive GADT : Type -> Type :=
| A : forall A, GADT A
| B : GADT bool.
And the following data type that has one constructor with an all-qualified type variable.
Inductive Wrap A :=
| wrap : GADT A -> Wrap A
| unwrap : forall X, GADT X -> (X -> Wrap A) -> Wrap A.
Then I want to define a recursive function that uses the function within unwrap.
Fail Fixpoint wrappedGADT {A} (xs: Wrap A) : option (GADT A) :=
match xs with
| wrap _ x => Some x
| unwrap _ _ fx k => match fx with
| A _ => None
| B => wrappedGADT (k true)
end
end.
With this definition I get the following error message.
The term "true" has type "bool" while it is expected to have type "T".
I was assuming that when I inspect fx and get case B, the parameter fx has type GADT bool, thus, the all-quantified type variable X is bool as well. Is this assumption wrong?
Next, I tried to explicitly type unwrap as follows.
Fail Fixpoint wrappedGADT {A} (xs: Wrap A) : option (GADT A) :=
match xs with
| wrap _ x => Some x
| #nwrap _ bool fx k => match fx with
| A _ => None
| B => wrappedGADT (k true)
end
end.
With this definition I get a very weird error message.
The term "true" has type "Datatypes.bool" while it is expected to have type "bool".
Can anybody give any pointers to the origin of this problem?
Unfortunately, raw match statements in Coq aren't always very smart about the kind of reasoning you're applying here. The "convoy pattern" (see CPDT for more information about it) is usually the answer for resolving this type of problem. The immediate application here would look something like:
Fail Fixpoint wrappedGADT {A} (xs: Wrap A) {struct xs} : option (GADT A) :=
match xs with
| wrap _ x => Some x
| unwrap _ _ fx k => match fx in (GADT T)
return ((T -> Wrap A) -> option (GADT A)) with
| A _ => fun k0 => None
| B => fun k0 => wrappedGADT (k0 true)
end k
end.
However, this runs into another issue, that Coq isn't able to verify the termination condition after passing the function through the "convoy". It seems that to work around that, it suffices to first define the function of recursive calls on values of k and then convoy that instead:
Fixpoint wrappedGADT {A} (xs: Wrap A) {struct xs} : option (GADT A) :=
match xs with
| wrap _ x => Some x
| unwrap _ _ fx k => let r := fun x => wrappedGADT (k x) in
match fx in (GADT T)
return ((T -> option (GADT A)) -> option (GADT A)) with
| A _ => fun _ => None
| B => fun r' => r' true
end r
end.
For your second code attempt, you're creating a local variable bool to hold the type called X in the unwrap constructor, which is then shadowing the Datatypes.bool definition. In general, there's no way to match only on one specific type in the Coq kernel language (although typeclasses provide a way to simulate that, somewhat).
Here is an alternative implementation, which constructs wrappedGADT's body using tactics. It has one advantage that it doesn't require manual return annotations from the user. The overall structure closely resembles your original code with the match expression.
It is crucial to use induction xs as opposed to destruct xs here, because the Wrap type is recursive.
Fixpoint wrappedGADT' {A} (xs: Wrap A) : option (GADT A).
induction xs as [x | ? fx k r].
- exact (Some x).
- destruct fx as [T | ].
+ exact None.
+ exact (r true).
Defined.
Print wrappedGADT'.
Here is a proof that the two implementations are extensionally equal.
Goal forall (A : Type) (xs : Wrap A),
wrappedGADT xs = wrappedGADT' xs.
Proof with auto.
intros A xs.
induction xs...
destruct g...
simpl; rewrite H; destruct (w true)...
Qed.
If we look at the term generated for wrappedGADT' (using Print wrappedGADT'.), we'll be able to construct one more solution using the Wrap_rect induction principle generated for the Wrap datatype (I just removed unused variable k from the match expression in wrappedGADT'):
Definition wrappedGADT'' {A} (xs: Wrap A) : option (GADT A) :=
Wrap_rect _
_
(fun t => Some t)
(fun _ fx k r =>
match fx in (GADT T)
return ((T -> option (GADT A)) -> option (GADT A)) with
| A _ => fun _ => None
| B => fun r' => r' true
end r)
xs.
This solution can then lead to a solution a-la Daniel's, if we unfold Wrap_rect, implemented as Fixpoint itself.
Related
I have trees of arbitrary arity, with the following type:
Inductive Tree : Set :=
| Node : list Tree -> Tree.
I can easily create a number of Fixpoint functions such as the following one:
Fixpoint nodecount (tree: Tree ) : nat :=
match tree with
| Node trs => S (sum (map nodecount trs))
end.
but none of the following 'filter' type, even in trivial cases such as this one :
Function nodecount' (tree: Tree ) : nat :=
match tree with
| Node trs => S (sum (map nodecount' ( filter ( fun x => true) trs)))
end.
Whatever the function behind the filter is, the compiler rejects the function as ill-formed.
Is there a way to provide Coq with a proof that this class of filter functions actually produces well-behaved terms, so that any member of this class of fixpoints is allowed ?
Thank you for your help !
One solution is to use mapfilter : (A -> option B) -> list A -> list B instead of filter and a separate map. You also need to be careful in defining mapfilter so that the function argument is not part of the fix arguments.
This works because after unfolding mapfilter in nodecount', the recursive call to nodecount' will be syntactically a subterm of the input tree.
Definition mapfilter {A B : Type} (f : A -> option B) : list A -> list B :=
fix mapfilter_f (xs : list A) : list B :=
match xs with
| nil => nil
| x :: xs => match f x with
| Some y => y :: mapfilter_f xs
| None => mapfilter_f xs
end
end.
Fixpoint nodecount' (p : Tree -> bool) (tree: Tree ) : nat :=
match tree with
| Node trs => S (sum (mapfilter (fun x => if p x then Some (nodecount' p x) else None) trs))
end.
Alternatively you can directly write the list recursion into the tree one:
Fixpoint nodecount (f : Tree -> bool) (t : Tree) : nat :=
if (f t) then
match t with
| Node l =>
(fix iter l1 :=
match l1 with
| nil => 1
| (a :: l2)%list => nodecount f a + iter l2
end) l
end
else 0.
Coq allows to write complex pattern-matchings, but then it decomposes them so that its kernel can handle them.
For instance, let us consider the following code.
Require Import List. Import ListNotations.
Inductive bar := A | B | C.
Definition f (l : list bar) :=
match l with
| _ :: A :: _ => 1
| _ => 2
end.
We pattern-match both on the list and on the second element. Printing f shows that Coq stores a more complex version of it.
Print f.
(* f = fun l : list bar => match l with
| [] => 2
| [_] => 2
| _ :: A :: _ => 1
| _ :: B :: _ => 2
| _ :: C :: _ => 2
end
: list bar -> nat
*)
The problem is that, in the proofs manipulating f, I have to deal with 5 cases instead of only 2, and 4 of them are redundant.
What is the best way to deal with this? Is there a way to reason with the pattern-matching as if it were exactly as defined?
You are correct in that Coq actually simplifies pattern-matching making a lot of redundancies appear.
There are however some ways to reason on the case analysis you meant opposed to what Coq understands.
Using Function and function induction is a way.
More recently, Equations also allows you to define pattern-matching for which it derives induction principles automatically (that you can invoke using funelim).
In order to convince coq cases can be factorised you have to use the notion of view.
They are described in the context of Equations in the examples.
I'll detail how to adapt your example to it.
From Equations Require Import Equations.
Require Import List. Import ListNotations.
Inductive bar := A | B | C.
Equations discr (b : list bar) : Prop :=
discr (_ :: A :: _) := False ;
discr _ := True.
Inductive view : list bar -> Set :=
| view_foo : forall x y, view (x :: A :: y)
| view_other : forall l, discr l -> view l.
Equations viewc l : view l :=
viewc (x :: A :: y) := view_foo x y ;
viewc l := view_other l I.
Equations f (l : list bar) : nat :=
f l with viewc l := {
| view_foo _ _ => 1 ;
| view_other _ _ => 2
}.
Goal forall l, f l < 3.
Proof.
intro l.
funelim (f l).
- repeat constructor.
- repeat constructor.
Qed.
As you can see, funelim only generates two subgoals.
It can be a bit heavy so if you don't want to use Equations of Function, you might have to prove your own induction principles by hand:
Require Import List. Import ListNotations.
Inductive bar := A | B | C.
Definition f (l : list bar) :=
match l with
| _ :: A :: _ => 1
| _ => 2
end.
Definition discr (l : list bar) : Prop :=
match l with
| _ :: A :: _ => False
| _ => True
end.
Lemma f_ind :
forall (P : list bar -> nat -> Prop),
(forall x y, P (x :: A :: y) 1) ->
(forall l, discr l -> P l 2) ->
forall l, P l (f l).
Proof.
intros P h1 h2 l.
destruct l as [| x [|[] l]].
3: eapply h1.
all: eapply h2.
all: exact I.
Qed.
Goal forall l, f l < 3.
Proof.
intro l.
eapply f_ind.
- intros. repeat constructor.
- intros. repeat constructor.
Qed.
The statement of the problem.
Consider this definition of map:
Fixpoint map (xs: list nat): (nat -> nat) -> list nat := match xs with
| nil => fun _ => nil
| x::xs' => fun f => (f x) :: (map xs' f)
end.
It works like this:
Coq < Eval simpl in map (1::2::3::List.nil) (fun x => x + 1).
= 2 :: 3 :: 4 :: nil
: list nat
How can I extend it to work on any types?
For example, in Haskell I can simply write as follows:
map :: forall a b. [a] -> (a -> b) -> [b]
map xs = case xs of
[ ] -> \_ -> [ ]
(x:xs') -> \f -> f x: map xs' f
But in Coq, I do not understand where I could place this forall quantifier.
My efforts.
The syntax reference explains the syntax of Fixpoint thusly:
Fixpoint ident binders {struct ident}? : type? := term
— So evidently there is no place in the syntax for a quantifier that binds a type variable over both binders and type. I tried placing forall here and there by guesswork but I could not make it work.
I can see how the type section could be made polymorphic in the result type of the function parameter without touching the binders section:
Fixpoint map (xs: list nat): forall B, (nat -> B) -> list B := match xs with
| nil => fun _ => nil
| x::xs' => fun f => f x :: (map xs' f)
end.
— But unfortunately this also gives an error, and cryptic enough for me at that:
In environment
map : list nat -> forall B : Type, (nat -> B) -> list B
xs : list nat
T : Type
The term "nil" has type "list ?A" while it is expected to have type
"(nat -> T) -> list T".
So, even for this simpler case I have no solution.
So, what can be done?
In Coq, the Fixpoint command is just a wrapper around the fix term constructor, which allows us to define anonymous recursive functions. A direct definition of map could be given as follows:
Require Import Coq.Lists.List.
Import ListNotations.
Definition map_anon : forall A B, (A -> B) -> list A -> list B :=
fix map A B (f : A -> B) (l : list A) : list B :=
match l with
| [] => []
| x :: l => f x :: map A B f l
end.
This is morally equivalent to the following definition:
Fixpoint map A B (f : A -> B) (l : list A) : list B :=
match l with
| [] => []
| x :: l => f x :: map A B f l
end.
Notice that A and B are bound as regular variables: in Coq, there is no distinction between types and terms, and these declarations causes Coq to infer their types as being Type. No forall quantifier is needed for the definition.
You can list all your arguments, including type arguments, after the name of the function. You'll put any arguments that depend on other arguments after the argument they depend on.
Fixpoint map (A B: Type) (xs: list A) (f: A -> B): list B :=
[...]
If you prefer foralls, you simply need to move everything (except the recursive argument and any arguments it depends on) to after the :.
Fixpoint map (A B: Type) (xs: list A): forall (f: A -> B), list B :=
[...]
Two things to note here. Since nothing after f depends on f, you could use the -> notation. This is purely notation and doesn't have any semantic difference.
Fixpoint map (A B: Type) (xs: list A): (A -> B) -> list B :=
[...]
The other thing to note is that when the arguments are after the : like this, we have to define a function, not just something in list B.
Fixpoint map (A B: Type) (xs: list A): (A -> B) -> list B :=
fun f => [...]
This is why you got the error The term "nil" has type "list ?A" while it is expected to have type "(nat -> T) -> list T".. We needed a function, not just something of type list B, which is what nil is.
When dealing with non-dependent types, Coq (usually) infers which argument is decreasing in a fixpoint. However, it is not the case with dependent types.
For instance, consider the following example in which I have a type A_list which ensures that a property P holds for all elements (of type A) in the list:
Require Import Coq.Lists.List.
Variable A: Type.
Variable P: A -> Prop.
Definition A_list := {a: list A | Forall P a}.
Now, say I want to have a fixpoint working with such a list recursively (the 2 lemmas are not interesting here. The dummy_arg is to simulate working with multiple arguments.) :
Lemma Forall_tl: forall P (h: A) t, Forall P (h::t) -> Forall P t.
Admitted.
Lemma aux: forall (l1: list A) l2 P, l1 = l2 -> Forall P l1 -> Forall P l2.
Admitted.
Fixpoint my_fixpoint (l: A_list) (dummy_arg: A) :=
match (proj1_sig l) as x return proj1_sig l = x -> bool with
| nil => fun _ => true
| hd::tl =>
fun h =>
my_fixpoint (exist (Forall P) tl (Forall_tl P hd tl (aux _ _ _ h (proj2_sig l)))) dummy_arg
end eq_refl.
Which, as expected, returns an error "Cannot guess decreasing argument of fix." since, strictly speaking, we are not decreasing on the argument. Nonetheless, we are obviously decreasing on proj1_sig l (the list embedded in the sig).
This is probably solvable using Program Fixpoints, but since it must be a very common pattern to decrease on a projection of a dependent type, I wonder what is the "right" way to manage such cases.
You can solve this problem using one of the methods I mentioned in this answer, including Program.
If you decouple the list and the proof, then it can be done using ordinary recursion :
Fixpoint my_fixpoint (l: list A) (pf : Forall P l) (dummy_arg: A) : bool :=
match l as x return Forall P x -> bool with
| nil => fun _ => true
| hd::tl => fun h => my_fixpoint tl (Forall_tl P hd tl h) dummy_arg
end pf.
Consider the definition of find in the standard library, which as the type find: forall A : Type, (A -> bool) -> list A -> option A.
Of course, find has to return an option A and not an A because we don't know wether there is a "valid" element in the list.
Now, say I find this definition of find painful, because we have to deal with the option, even when we are sure that such an element exists in the list.
Hence, I'd like to define myFind which additionnaly takes a proof that there is such an element in the list. It would be something like:
Variable A: Type.
Fixpoint myFind
(f: A -> bool)
(l: list A)
(H: exists a, In a l /\ f a = true): A :=
...
If I am not mistaken, such a signature informally says: "Give me a function, a list, and a proof that you have a "valid" element in the list".
My question is: how can I use the hypothesis provided and define my fixpoint ?
What I have in mind is something like:
match l with
| nil => (* Use H to prove this case is not possible *)
| hd :: tl =>
if f hd
then hd
else
(* Use H and the fact that f hd = false
to prove H': exists a, In a tl /\ f a = true *)
myFind f tl H'
end.
An bonus point would be to know whether I can embbed a property about the result directly within the type, for instance in our case, a proof that the return value r is indeed such that f r = true.
We can implement this myFind function by structural recursion over the input list. In the case of empty list the False_rect inductive principle is our friend because it lets us switch from the logical world to the world of computations. In general we cannot destruct proofs of propositions if the type of the term under construction lives in Type, but if we have an inconsistency the system lets us.
We can handle the case of the non-empty input list by using the convoy pattern (there is a number of great answers on Stackoverflow explaining this pattern) and an auxiliary lemma find_not_head.
It might be useful to add that I use the convoy pattern twice in the implementation below: the one on the top level is used to let Coq know the input list is empty in the first match-branch -- observe that the type of H is different in both branches.
From Coq Require Import List.
Import ListNotations.
Set Implicit Arguments.
(* so we can write `f a` instead of `f a = true` *)
Coercion is_true : bool >-> Sortclass.
Section Find.
Variables (A : Type) (f : A -> bool).
(* auxiliary lemma *)
Fact find_not_head h l : f h = false ->
(exists a, In a (h :: l) /\ f a) ->
exists a, In a l /\ f a.
Proof. intros E [a [[contra | H] fa_true]]; [congruence | now exists a]. Qed.
Fixpoint myFind (l : list A) (H : exists a : A, In a l /\ f a) : {r : A | f r} :=
match l with
| [] => fun H : exists a : A, In a [] /\ f a =>
False_rect {r : A | f r}
match H with
| ex_intro _ _ (conj contra _) =>
match contra with end
end
| h :: l => fun H : exists a : A, In a (h :: l) /\ f a =>
(if f h as b return (f h = b -> {r : A | f r})
then fun Efh => exist _ h Efh
else fun Efh => myFind l (find_not_head Efh H)) eq_refl
end H.
End Find.
Here is a simplistic test:
From Coq Require Import Arith.
Section FindTest.
Notation l := [1; 2; 0; 9].
Notation f := (fun n => n =? 0).
Fact H : exists a, In a l /\ f a.
Proof. exists 0; intuition. Qed.
Compute myFind f l H.
(*
= exist (fun r : nat => f r) 0 eq_refl
: {r : nat | f r}
*)
End FindTest.
You can also use Program to help you construct the proof arguments interactively. You fill in as much as you can in the program body and leave _ blanks that you get to fill in later with proof tactics.
Require Import List Program.
Section Find.
Variable A : Type.
Variable test : A -> bool.
Program Fixpoint FIND l (H:exists a, test a = true /\ In a l) : {r | test r = true} :=
match l with
| [] => match (_:False) with end
| a::l' => if dec (test a) then a else FIND l' _
end.
Next Obligation.
firstorder; congruence.
Defined.
End Find.
Program is a little better at not forgetting information when you do case analysis (it knows the convoy pattern) but it is not perfect, hence the use of dec in the if statement.
(Notice how Coq was able to handle the first obligation, to construct a term of type False, all by itself!)