Default implementations in coq’s Modules - module

I have an interface that I want to implement several times:
Module Type I.
Parameter a : A.
Parameter b : B.
Parameter c : C.
End I.
(and assume that each of a, b and c are actually many definitions).
An implementation would be
Module Imp1 <: I.
Definition a : A := bar.
Definition b : B := foo a.
Definition c : C := baz a b.
End I.
Now it turns out that many implementations share the definition of b (which require a), but have different definitions of c.
How can I centralize the definition of b? Preferably without changing I or duplicating lots of definitions thereof?
(I imagine writing a module functor BImp expecting a:A as some kind of parameter, and then I can Import (BImp a).)

You can outsource your shared definitions into a global definition (here outsourced) parameterized on the changing parts of your module (here a). I don't know if there is something like Haskell's default implementations.
Module Type I.
Parameter a : A.
Parameter b : B.
Parameter c : C.
End I.
Definition outsourced (a:A) := foo a.
Module Imp1 <: I.
Definition a : A := bar.
Definition b : B := outsourced a.
Definition c : C := baz a b.
End Imp1.
Module Imp2 <: I.
Definition a : A := bar'.
Definition b : B := outsourced a.
Definition c : C := baz' a b.
End Imp2.

You can instanciate modules inside other modules. This forces you to duplicate part the modules' signatures, but not the proofs the modules contain.
Module Type PreorderSignature.
Parameter Inline type : Type.
Parameter Inline less : type -> type -> Prop.
Parameter Inline reflexivity : forall x1, less x1 x1.
Parameter Inline transitivity : forall x1 x2 x3, less x1 x2 -> less x2 x3 -> less x1 x3.
End PreorderSignature.
Module Preorder (PS : PreorderSignature).
Import PS.
(* Preorder facts. *)
End Preorder.
Module Type EquivalenceRelationSignature.
Parameter Inline type : Type.
Parameter Inline equal : type -> type -> Prop.
Parameter Inline reflexivity : forall x1, equal x1 x1.
Parameter Inline symmetry : forall x1 x2, equal x1 x2 -> equal x2 x1.
Parameter Inline transitivity : forall x1 x2 x3, equal x1 x2 -> equal x2 x3 -> equal x1 x3.
End EquivalenceRelationSignature.
Module EquivalenceRelation (ERS : EquivalenceRelationSignature).
Import ERS.
Module PreorderSignatureInstance <: PreorderSignature.
Definition type := type.
Definition less := equal.
Definition reflexivity := reflexivity.
Definition transitivity := transitivity.
End PreorderSignatureInstance.
Module PreorderInstance := Preorder PreorderSignatureInstance.
Import PreorderInstance.
(* Now your equivalence relations will inherit all the facts about preorders. *)
(* Other equivalence relation facts. *)
End EquivalenceRelation.
Module Type PartialOrderSignature.
Parameter Inline type : Type.
Parameter Inline less : type -> type -> Prop.
Parameter Inline reflexivity : forall x1, less x1 x1.
Parameter Inline antisymmetry : forall x1 x2, less x1 x2 -> less x2 x1 -> x1 = x2.
Parameter Inline transitivity : forall x1 x2 x3, less x1 x2 -> less x2 x3 -> less x1 x3.
End PartialOrderSignature.
Module PartialOrder (POS : PartialOrderSignature).
Import POS.
Module PreorderSignatureInstance <: PreorderSignature.
Definition type := type.
Definition less := less.
Definition reflexivity := reflexivity.
Definition transitivity := transitivity.
End PreorderSignatureInstance.
Module PreorderInstance := Preorder PreorderSignatureInstance.
Import PreorderInstance.
(* Now your partial orders will inherit all the facts about preorders. *)
(* Other partial order facts. *)
End PartialOrder.
And to flatten the module hierarchy a bit you can use the Import and Parameter Inline commands.

Related

How to check equality between two integers in Coq?

I'm trying to check the equality between two integers in Coq, but I get this error: "The term "first = second" has type "Prop" which is not a (co-)inductive type.". Is there any library in Coq that provides equality checking? Here is my code:
Definition verify_eq (first : Z) (second : Z) : Z :=
if first = second then 0 else 1.
You're in luck! In the same module where Z is defined (I'm assuming ZArith in the standard library), there's a term Z.eqb : Z -> Z -> bool that gives a a boolean test for integer equality (technically it's in the submodule Z — that's why there's a Z in the name).
Require Import ZArith. (* I assume you already imported this, since you're using Z *)
Definition verify_eq (first : Z) (second : Z) : Z :=
if Z.eqb first second then 0 else 1.

Type Level Fix Point while Ensuring Termination

It is possible to represent to some how make unFix total? Possibly by restricting what f is?
record Fix (f : Type -> Type) where
constructor MkFix
unFix : f (Fix f)
> :total unFix
Fix.unFix is possibly not total due to:
MkFix, which is not strictly positive
The problem here is that Idris has no way of knowing that the base functor you are using for your datatype is strictly positive. If it were to accept your definition, you could then use it with a concrete, negative functor and prove Void from it.
There are two ways to represent strictly positive functors: by defining a universe or by using containers. I have put everything in two self-contained gists (but there are no comments there).
A Universe of Strictly Positive Functors
You can start with a basic representation: we can decompose a functor into either a sigma type (Sig), a (strictly-positive) position for a recursive substructure (Rec) or nothing at all (End). This gives us this description and its decoding as a Type -> Type function:
-- A universe of positive functor
data Desc : Type where
Sig : (a : Type) -> (a -> Desc) -> Desc
Rec : Desc -> Desc
End : Desc
-- The decoding function
desc : Desc -> Type -> Type
desc (Sig a d) x = (v : a ** desc (d v) x)
desc (Rec d) x = (x, desc d x)
desc End x = ()
Once you have this universe of functors which are guaranteed to be strictly positive, you can take their least fixpoint:
-- The least fixpoint of such a positive functor
data Mu : Desc -> Type where
In : desc d (Mu d) -> Mu d
You can now define your favourite datatype.
Example: Nat
We start with a sum type of tags for each one of the constructors.
data NatC = ZERO | SUCC
We then define the strictly positive base functor by storing the constructor tag in a sigma and computing the rest of the description based on the tag value. The ZERO tag is associated to End (there is nothing else to store in a zero constructor) whilst the SUCC one demands a Rec End, that is to say one recursive substructure corresponding to the Nat's predecessor.
natD : Desc
natD = Sig NatC $ \ c => case c of
ZERO => End
SUCC => Rec End
Our inductive type is then obtained by taking the fixpoint of the description:
nat : Type
nat = Mu natD
We can naturally recover the constructors we expect:
zero : nat
zero = In (ZERO ** ())
succ : nat -> nat
succ n = In (SUCC ** (n, ()))
References
This specific universe is taken from 'Ornamental Algebras, Algebraic Ornaments' by McBride but you can find more details in 'The Gentle Art of Levitation' by Chapman, Dagand, McBride, and Morris.
Strictly Positive Functors as the Extension of Containers
The second representation is based on another decomposition: each inductive type is seen as a general shape (i.e. its constructors and the data they store) plus a number of recursive positions (which can depend on the specific value of the shape).
record Container where
constructor MkContainer
shape : Type
position : shape -> Type
Once more we can give it an interpretation as a Type -> Type function:
container : Container -> Type -> Type
container (MkContainer s p) x = (v : s ** p v -> x)
And take the fixpoint of the strictly positive functor thus defined:
data W : Container -> Type where
In : container c (W c) -> W c
You can once more recover your favourite datatypes by defining Containers of interest.
Example: Nat
Natural numbers have two constructors, each storing nothing at all. So the shape will be a Bool. If we are in the zero case then there are no recursive positions (Void) and in the succ one there is exactly one (()).
natC : Container
natC = MkContainer Bool (\ b => if b then Void else ())
Our type is obtained by taking the fixpoint of the container:
nat : Type
nat = W natC
And we can recover the usual constructors:
zero : nat
zero = In (True ** \ v => absurd v)
succ : nat -> nat
succ n = In (False ** \ _ => n)
References
This is based on 'Containers: Constructing Strictly Positive Types' by Abbott, Altenkirch, and Ghani.

What is eq_rect and where is it defined in Coq?

From what I have read, eq_rect and equality seem deeply interlinked. Weirdly, I'm not able to find a definition on the manual for it.
Where does it come from, and what does it state?
If you use Locate eq_rect you will find that eq_rect is located in Coq.Init.Logic, but if you look in that file there is no eq_rect in it. So, what's going on?
When you define an inductive type, Coq in many cases automatically generates 3 induction principles for you, appending _rect, _rec, _ind to the name of the type.
To understand what eq_rect means you need its type,
Check eq_rect.
here we go:
eq_rect
: forall (A : Type) (x : A) (P : A -> Type),
P x -> forall y : A, x = y -> P y
and you need to understand the notion of Leibniz's equality:
Leibniz characterized the notion of equality as follows:
Given any x and y, x = y if and only if, given any predicate P, P(x) if and only if P(y).
In this law, "P(x) if and only if P(y)" can be weakened to "P(x) if P(y)"; the modified law is equivalent to the original, since a statement that applies to "any x and y" applies just as well to "any y and x".
Speaking less formally, the above quotation says that if x and y are equal, their "behavior" for every predicate is the same.
To see more clearly that Leibniz's equality directly corresponds to eq_rect we can rearrange the order of parameters of eq_rect into the following equivalent formulation:
eq_rect_reorder
: forall (A : Type) (P : A -> Type) (x y : A),
x = y -> P x -> P y

Obtain decidable total order on a type from an injection into `nat`

Since the natural numbers support a decidable total order, the injection nat_of_ascii (a : ascii) : nat induces a decidable total order on the type ascii. What would be a concise, idiomatic way of expressing this in Coq? (With or without type classes, modules, etc.)
Such process is fairly routine and will depend on the library you have chosen. For order.v, based on math-comp, the process is totally mechanical [in fact, we'll develop a general construction for types with an injection to total orders later in the post]:
From Coq Require Import Ascii String ssreflect ssrfun ssrbool.
From mathcomp Require Import eqtype choice ssrnat.
Require Import order.
Import Order.Syntax.
Import Order.Theory.
Lemma ascii_of_natK : cancel nat_of_ascii ascii_of_nat.
Proof. exact: ascii_nat_embedding. Qed.
(* Declares ascii to be a member of the eq class *)
Definition ascii_eqMixin := CanEqMixin ascii_of_natK.
Canonical ascii_eqType := EqType _ ascii_eqMixin.
(* Declares ascii to be a member of the choice class *)
Definition ascii_choiceMixin := CanChoiceMixin ascii_of_natK.
Canonical ascii_choiceType := ChoiceType _ ascii_choiceMixin.
(* Specific stuff for the order library *)
Definition ascii_display : unit. Proof. exact: tt. Qed.
Open Scope order_scope.
(* We use the order from nat *)
Definition lea x y := nat_of_ascii x <= nat_of_ascii y.
Definition lta x y := ~~ (lea y x).
Lemma lea_ltNeq x y : lta x y = (x != y) && (lea x y).
Proof.
rewrite /lta /lea leNgt negbK lt_neqAle.
by rewrite (inj_eq (can_inj ascii_of_natK)).
Qed.
Lemma lea_refl : reflexive lea.
Proof. by move=> x; apply: le_refl. Qed.
Lemma lea_trans : transitive lea.
Proof. by move=> x y z; apply: le_trans. Qed.
Lemma lea_anti : antisymmetric lea.
Proof. by move=> x y /le_anti /(can_inj ascii_of_natK). Qed.
Lemma lea_total : total lea.
Proof. by move=> x y; apply: le_total. Qed.
(* We can now declare ascii to belong to the order class. We must declare its
subclasses first. *)
Definition asciiPOrderMixin :=
POrderMixin lea_ltNeq lea_refl lea_anti lea_trans.
Canonical asciiPOrderType := POrderType ascii_display ascii asciiPOrderMixin.
Definition asciiLatticeMixin := Order.TotalLattice.Mixin lea_total.
Canonical asciiLatticeType := LatticeType ascii asciiLatticeMixin.
Canonical asciiOrderType := OrderType ascii lea_total.
Note that providing an order instance for ascii gives us access to a large theory of total orders, plus operators, etc..., however the definition of total itself is fairly simple:
"<= is total" == x <= y || y <= x
where <= is a "decidable relation" and we assume, of course, decidability of equality for the particular type. Concretely, for an arbitrary relation:
Definition total (T: Type) (r : T -> T -> bool) := forall x y, r x y || r y x.
so if T is and order, and satisfies total, you are done.
More generally, you can define a generic principle to build such types using injections:
Section InjOrder.
Context {display : unit}.
Local Notation orderType := (orderType display).
Variable (T : orderType) (U : eqType) (f : U -> T) (f_inj : injective f).
Open Scope order_scope.
Let le x y := f x <= f y.
Let lt x y := ~~ (f y <= f x).
Lemma CO_le_ltNeq x y: lt x y = (x != y) && (le x y).
Proof. by rewrite /lt /le leNgt negbK lt_neqAle (inj_eq f_inj). Qed.
Lemma CO_le_refl : reflexive le. Proof. by move=> x; apply: le_refl. Qed.
Lemma CO_le_trans : transitive le. Proof. by move=> x y z; apply: le_trans. Qed.
Lemma CO_le_anti : antisymmetric le. Proof. by move=> x y /le_anti /f_inj. Qed.
Definition InjOrderMixin : porderMixin U :=
POrderMixin CO_le_ltNeq CO_le_refl CO_le_anti CO_le_trans.
End InjOrder.
Then, the ascii instance gets rewritten as follows:
Definition ascii_display : unit. Proof. exact: tt. Qed.
Definition ascii_porderMixin := InjOrderMixin (can_inj ascii_of_natK).
Canonical asciiPOrderType := POrderType ascii_display ascii ascii_porderMixin.
Lemma lea_total : #total ascii (<=%O)%O.
Proof. by move=> x y; apply: le_total. Qed.
Definition asciiLatticeMixin := Order.TotalLattice.Mixin lea_total.
Canonical asciiLatticeType := LatticeType ascii asciiLatticeMixin.
Canonical asciiOrderType := OrderType ascii lea_total.

vector reflexivity under setoid equality using CoRN MathClasses

I have a simple lemma:
Lemma map2_comm: forall A (f:A->A->B) n (a b:t A n),
(forall x y, (f x y) = (f y x)) -> map2 f a b = map2 f b a.
which I was able to prove using standard equality (≡). Now I am need to prove the similar lemma using setoid equality (using CoRN MathClasses). I am new to this library and type classes in general and having difficulty doing so. My first attempt is:
Lemma map2_setoid_comm `{Equiv B} `{Equiv (t B n)} `{Commutative B A}:
forall (a b: t A n),
map2 f a b = map2 f b a.
Proof.
intros.
induction n.
dep_destruct a.
dep_destruct b.
simpl.
(here '=' is 'equiv'). After 'simpl' the goal is "(nil B)=(nil B)" or "[]=[]" using VectorNotations. Normally I would finish it using 'reflexivity' tactics but it gives me:
Tactic failure: The relation equiv is not a declared reflexive relation. Maybe you need to require the Setoid library.
I guess I need somehow to define reflexivity for vector types, but I am not sure how to do that. Please advise.
First of all the lemma definition needs to be adjusted to:
Lemma map2_setoid_comm : forall `{CO:Commutative B A f} `{SB: !Setoid B} ,
forall n:nat, Commutative (map2 f (n:=n)).
To be able to use reflexivity:
Definition vec_equiv `{Equiv A} {n}: relation (vector A n) := Vforall2 (n:=n) equiv.
Instance vec_Equiv `{Equiv A} {n}: Equiv (vector A n) := vec_equiv.