Adding a lemma to an Instance of type Class in Coq - coq

In file SemiRing.v I defined some classes:
(** Setoids. *)
Class Setoid := {
s_typ :> Type;
s_eq : relation s_typ;
s_eq_Equiv : Equivalence s_eq }.
Existing Instance s_eq_Equiv.
Module Import Setoid_Notations.
Infix "==" := s_eq.
End Setoid_Notations.
Instance Leibniz_Setoid (A : Type) : Setoid.
Proof.
apply Build_Setoid with (s_eq := #eq A). constructor. fo. fo.
unfold Transitive. apply eq_trans.
Defined.
(** Setoids with decidable equivalence. *)
Class Decidable_Setoid := {
ds_setoid :> Setoid;
ds_eq_dec : forall x y, {s_eq x y} + {~s_eq x y} }.
Class SemiRing := {
sr_ds :> Decidable_Setoid;
sr_0 : s_typ;
sr_1 : s_typ;
sr_add : s_typ -> s_typ -> s_typ;
sr_add_eq : Proper (s_eq ==> s_eq ==> s_eq) sr_add;
sr_mul : s_typ -> s_typ -> s_typ;
sr_mul_eq : Proper (s_eq ==> s_eq ==> s_eq) sr_mul;
sr_th : semi_ring_theory sr_0 sr_1 sr_add sr_mul s_eq }.
Then I define a NSemiRing.v is an instance of SemiRing for natural numbers.
Require Import SemiRing.
Instance Nat_as_Setoid : Setoid := Leibniz_Setoid nat. (*Where A = nat *)
Instance Nat_as_DS : Decidable_Setoid.
Proof.
apply Build_Decidable_Setoid with (ds_setoid := Nat_as_Setoid).
apply eq_nat_dec.
Defined.
Instance Nat_as_SR : SemiRing.
Proof.
apply Build_SemiRing with (sr_ds := Nat_as_DS) (sr_0 := 0) (sr_1 := 1)
(sr_add := plus) (sr_mul := mult).
class. class. constructor; intros; simpl; try ring. refl.
Defined.
My question is:
I want to have a lemma for example:
Lemma Aadd_0_r (n: nat) : n + 0 = n.
Proof. ... Qed.
How can I add or make this lemma Aadd_0_r of type nat see as one of the field of Nat_as_SR of type SemiRing?
That in another file I import NSemiRing:
Require Import NSemiRing.
Context {S: SemiRing}. Import Setoid_Notations.
For example, if I have a lemma that have the form of :
Lemma add_zero_r (n: s_typ): n + 0 == n.
Where I want "s_typ" is automatically recognize as type "nat" and I can call the Lemma Aadd_0_r to prove this lemma.

Doesn't just Proof. apply Aadd_0_r. Qed. finish the proof?
If you turn off notations and unfold all the definitions your goal reduces to Aadd_0_r.

Related

Using a module's definition in Coq

The following code states that it defines finite sets in Coq with the axiom of extensionality:
(** A library for finite sets with extensional equality.
Author: Brian Aydemir. *)
Require Import FSets.
Require Import ListFacts.
Require Import Coq.Logic.ProofIrrelevance.
(* *********************************************************************** *)
(** * Interface *)
(** The following interface wraps the standard library's finite set
interface with an additional property: extensional equality. *)
Module Type S.
Declare Module E : UsualOrderedType.
Declare Module F : FSetInterface.S with Module E := E.
Parameter eq_if_Equal :
forall s s' : F.t, F.Equal s s' -> s = s'.
End S.
(* *********************************************************************** *)
(** * Implementation *)
(** For documentation purposes, we hide the implementation of a
functor implementing the above interface. We note only that the
implementation here assumes (as an axiom) that proof irrelevance
holds. *)
Module Make (X : UsualOrderedType) <: S with Module E := X.
(* begin hide *)
Module E := X.
Module F := FSetList.Make E.
Module OFacts := OrderedType.OrderedTypeFacts E.
Lemma eq_if_Equal :
forall s s' : F.t, F.Equal s s' -> s = s'.
Proof.
intros [s1 pf1] [s2 pf2] Eq.
assert (s1 = s2).
unfold F.MSet.Raw.t in *.
eapply Sort_InA_eq_ext; eauto.
intros; eapply E.lt_trans; eauto.
1 : {
apply F.MSet.Raw.isok_iff.
auto.
}
1 : {
apply F.MSet.Raw.isok_iff.
auto.
}
subst s1.
assert (pf1 = pf2).
apply proof_irrelevance.
subst pf2.
reflexivity.
Qed.
(* end hide *)
End Make.
How can I define a function with signature from finite sets to finite sets using this module?
You need to define a Module (call it M) that implements the UsualOrderedType module type for the type you want to make finite sets out of, and then build another Module with Make M which contains an implementation of finite sets for your type.
Module M <: UsualOrderedType.
...
End M.
Module foo := Make M.
Check foo.F.singleton.
Note that you need to declare the module type with <: instead of just :, otherwise you are hiding the fact that the module is defined for (in the example below) nat behind an opaque type t.
Say you want to make finite sets of nats:
(* Print the module type to see all the things you need to define. *)
Print Module Type UsualOrderedType.
Require Import PeanonNat.
Module NatOrdered <: UsualOrderedType . (* note the `<:` *)
Definition t:=nat.
Definition eq:=#eq nat.
Definition lt:=lt.
Definition eq_refl:=#eq_refl nat.
Definition eq_sym:=#eq_sym nat.
Definition eq_trans:=#eq_trans nat.
Definition lt_trans:=Nat.lt_trans.
(* I wrote Admitted where I didn't provide an implementation *)
Definition lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Admitted.
Definition compare : forall x y : t, Compare lt eq x y. Admitted.
Definition eq_dec : forall x y : t, {eq x y} + {~ eq x y}. Admitted.
End NatOrdered.
Now you can create a module that uses this ordered type.
Module foo := Make NatOrdered.
Print foo.F. (* to see everything that is defined for the FSetList *)
Import foo. (* get F in our namespace so we can say F.t instead of foo.F.t, etc. *)
Now we can use our F module. The finite sets have type F.t and the elements have type F.elt which is coercible to nat since we know they come from NatOrdered.
Lets build a function that uses stuff from F.
Definition f: F.elt -> F.t.
intros x. apply (F.singleton x).
Defined.
Print F.
Goal F.cardinal (F.union (f 1) (f 2)) = 2.
compute.
Ok. That gets stuck halfway through the computation because I didn't implement compare above. I was lazy and just wrote Admitted. But you can do it! :-)

Instantiating a commutative ring of Zn with mathcomp

I was able to create a ComRingMixin, but when I try to declare this type as a canonical ring, Coq complains:
x : phantom (GRing.Zmodule.class_of ?bT) (GRing.Zmodule.class ?bT)
The term "x" has type "phantom (GRing.Zmodule.class_of ?bT) (GRing.Zmodule.class ?bT)"
while it is expected to have type "phantom (GRing.Zmodule.class_of 'I_n) ?b".
This is what I have so far, I was able to define the operations and instantiate the abelian group mixin as well as the canonical declaration, but for the ring, my code fails.
From mathcomp Require Import all_ssreflect all_algebra.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Import GRing.Theory.
Open Scope ring_scope.
Section Zn.
Variables n :nat.
Axiom one_lt_n : (1 < n)%N.
Axiom z_lt_n : (0 < n)%N.
Lemma mod_lt_n : forall (x : nat), ((x %% n)%N < n)%N.
Proof.
move=> x0; rewrite ltn_mod; by exact: z_lt_n.
Qed.
Definition mulmod (a b : 'I_n) : 'I_n := Ordinal (mod_lt_n (((a*b)%N %% n)%N)).
Definition addmod (a b : 'I_n) : 'I_n := Ordinal (mod_lt_n (((a+b)%N %% n)%N)).
Definition oppmod (x : 'I_n) : 'I_n := Ordinal (mod_lt_n (n - x)%N).
Lemma addmodC : commutative addmod. Admitted.
Lemma addmod0 : left_id (Ordinal z_lt_n) addmod. Admitted.
Lemma oppmodK : involutive oppmod. Admitted.
Lemma addmodA : associative addmod. Admitted.
Lemma addmodN : left_inverse (Ordinal z_lt_n) oppmod addmod. Admitted.
Definition Mixin := ZmodMixin addmodA addmodC addmod0 addmodN.
Canonical ordn_ZmodType := ZmodType 'I_n Mixin.
Lemma mulmodA : associative mulmod. Admitted.
Lemma mulmodC : commutative mulmod. Admitted.
Lemma mulmod1 : left_id (Ordinal one_lt_n) mulmod. Admitted.
Lemma mulmod_addl : left_distributive mulmod addmod. Admitted.
Lemma one_neq_0_ord : (Ordinal one_lt_n) != Ordinal z_lt_n. Proof. by []. Qed.
Definition mcommixin := #ComRingMixin ordn_ZmodType (Ordinal one_lt_n) mulmod mulmodA mulmodC mulmod1 mulmod_addl one_neq_0_ord.
Canonical ordnRing := RingType 'I_n mcommixin.
Canonical ordncomRing := ComRingType int intRing.mulzC.
What am i doing wrong? I'm basing myself on http://www-sop.inria.fr/teams/marelle/advanced-coq-17/lesson5.html.
The problem is that ssralg already declares ordinal as a zmodType instance. There can only be one canonical instance of a structure per head symbol, so your declaration of ordn_ZmodType is effectively ignored.
One solution around it is to introduce a local synonym in this section and use it to define the canonical structures:
(* ... *)
Definition foo := 'I_n.
(* ... *)
Definition ordn_ZmodType := ZmodType foo Mixin.
(* ... *)
Canonical ordnRing := RingType foo mcommixin. (* This now works *)
The other solution is to use the ringType instance defined in MathComp for ordinal. The catch is that it is only defined for types of the form 'I_n.+2.
In principle, one could also have declared these instances assuming the same axioms on n as you did, but this would make the inference of canonical structures more difficult.
Check fun n => [ringType of 'I_n.+2].
(* ... : nat -> ringType *)

Coq Import problems

I'm trying to import Library Coq.Structures.OrdersFacts as usual with:
Require Import Coq.Structures.OrdersFacts
Then I try to use of the lemmas there with either:
apply CompareFacts.compare_nlt_iff. or apply compare_nlt_iff.
But none work ... what am I missing?
CompareFacts is a Module Type, not a Module. You can see that if you do
Require Import Coq.Structures.OrdersFacts.
Print OrdersFacts.CompareFacts.
Find a Module of this type and apply its Lemmas instead.
EDIT:
I meant that to use the lemmas on i.e. nat, you need a module that shows that nat is a DecStrOrder' (and Nat from PeanoNat is such a module), and also one that specializes CompareFacts for nat .
Perhaps an example is more useful.
Require Import Coq.Structures.OrdersFacts.
Module mymodule (O:DecStrOrder') (T: CompareFacts O).
Import T.
Import O.
Check compare_eq_iff. (* from CompareFacts *)
(* a theorem about terms of type O.t *)
Lemma lem1 a b c: (a ?= b) = Eq -> b == c -> c == a.
intros.
rewrite compare_eq_iff in H. (* here we use the lemma *)
rewrite H.
rewrite H0.
apply eq_equiv.
Qed.
End mymodule.
(* the above module functor can be specialised for i.e. nat *)
Require Import PeanoNat.
Print CompareFacts.
Module M : CompareFacts Nat.
Definition compare_eq_iff := Nat.compare_eq_iff.
Definition compare_eq := Nat.compare_eq.
Definition compare_lt_iff := Nat.compare_lt_iff.
Definition compare_gt_iff := Nat.compare_gt_iff.
Definition compare_nlt_iff := Nat.compare_nlt_iff.
Definition compare_ngt_iff := Nat.compare_ngt_iff.
Definition compare_refl := Nat.compare_refl.
Definition compare_compat: Proper (eq==>eq==>eq) Nat.compare.
intros x y Hxy a b Hab; now subst. Defined.
Definition compare_antisym := Nat.compare_antisym.
End M.
Module natmodule := mymodule Nat M.
Check natmodule.lem1.

Coinduction on Coq, type mismatch

I've been trying out coinductive types and decided to define coinductive versions of the natural numbers and the vectors (lists with their size in the type). I defined them and the infinite number as so:
CoInductive conat : Set :=
| cozero : conat
| cosuc : conat -> conat.
CoInductive covec (A : Set) : conat -> Set :=
| conil : covec A cozero
| cocons : forall (n : conat), A -> covec A n -> covec A (cosuc n).
CoFixpoint infnum : conat := cosuc infnum.
It all worked except for the definition I gave for an infinite covector
CoFixpoint ones : covec nat infnum := cocons 1 ones.
which gave the following type mismatch
Error:
In environment
ones : covec nat infnum
The term "cocons 1 ones" has type "covec nat (cosuc infnum)" while it is expected to have type
"covec nat infnum".
I thought the compiler would accept this definition since, by definition, infnum = cosuc infnum. How can I make the compiler understand these expressions are the same?
The standard way to solve this issue is described in Adam Chlipala's CPDT (see the chapter on Coinduction).
Definition frob (c : conat) :=
match c with
| cozero => cozero
| cosuc c' => cosuc c'
end.
Lemma frob_eq (c : conat) : c = frob c.
Proof. now destruct c. Qed.
You can use the above definitions like so:
CoFixpoint ones : covec nat infnum.
Proof. rewrite frob_eq; exact (cocons 1 ones). Defined.
or, perhaps, in a bit more readable way:
Require Import Coq.Program.Tactics.
Program CoFixpoint ones : covec nat infnum := cocons 1 ones.
Next Obligation. now rewrite frob_eq. Qed.

How to pull the rhs out of an equality in coq

If I have the following:
H : some complicated expression = some other complicated expression
and I want to grab
u := some other complicated expression
without hardcoding it into my proof (i.e., using pose)
Is there a clean way to do this in LTac?
I am sure there are other ltac ways to do it, in my case I prefer to use SSReflect's contextual pattern language to do it. (You'll need to install the plugin or use Coq >= 8.7 which includes SSReflect):
(* ce_i = complicated expression i *)
Lemma example T (ce_1 ce_2 : T) (H : ce_1 = ce_2) : False.
set u := (X in _ = X) in H.
resulting goal:
T : Type
ce_1, ce_2 : T
u := ce_2 : T
H : ce_1 = u
============================
False
Usually you can refine the pattern more and more until you get a pretty stable match.
Note that this happens to be the first example of the section 8.3 "Contextual patterns" in the SSReflect manual.
Here is another version, which uses Ltac and its ability to pattern-match on types of terms:
Tactic Notation "assign" "rhs" "of" ident(H) "to" ident(u) "in" ident(H') :=
match type of H with _ = ?rhs => set (u := rhs) in H' end.
Tactic Notation "assign" "rhs" "of" ident(H) "to" ident(u) "in" "*" :=
match type of H with _ = ?rhs => set (u := rhs) in * end.
We can create more variants of the above (see e.g. here). Here is how to use it:
Lemma example {T} (ce1 ce2 ce3 : T) (H1 : ce1 = ce2) (H2 : ce2 = ce3) : ce1 = ce3.
Proof.
assign rhs of H1 to u in *.
Proof state:
u := ce2 : T
H1 : ce1 = u
H2 : u = ce3
============================
ce1 = ce3
One more time:
Undo.
assign rhs of H1 to u in H1.
Proof state:
u := ce2 : T
H1 : ce1 = u
H2 : ce2 = ce3
============================
ce1 = ce3