Commit 3d69aaa0 authored by Filip Sieczkowski's avatar Filip Sieczkowski

Added a library for solving recursive domain equations.

parents
This diff is collapsed.
(** This file provides the proof that CBUlt, the category of complete,
bisected, ultrametric spaces, forms an M-category. *)
Require Import MetricCore.
Require Import MetricRec.
Module CBUlt <: MCat.
Local Open Scope cat_scope.
Local Obligation Tactic := intros; resp_set || eauto with typeclass_instances.
Definition M := cmtyp.
Instance MArr : BC_morph M := fun U V : cmtyp => cmfromType (U -n> V).
Instance MComp : BC_comp M := fun U V W => comp.
Instance MId : BC_id M := fun U => (umid _).
Instance MTermO : BC_term M := cmfromType unit.
Program Instance MTermA : BC_terminal M := fun U => n[(const tt)].
Instance Cat : BaseCat M.
Proof.
split; intros; intros n; simpl; reflexivity || exact I.
Qed.
Section Limits.
Context (T : Tower).
Definition guard := fun (σ : forall i, tow_objs T i) => forall n, tow_morphs T n (σ (S n)) == σ n.
Instance lpg : LimitPreserving guard.
Proof.
intros σ σc HG n.
rewrite !dep_chain_compl.
rewrite nonexp_continuous; apply umet_complete_ext; intros k.
simpl; apply HG.
Qed.
Definition lim_obj : cmtyp := cmfromType {σ : forall i, tow_objs T i | guard σ}.
Definition lim_proj i : lim_obj -n> tow_objs T i := MprojI i <M< inclM.
Program Definition lim_cone : Cone T := mkBaseCone T lim_obj lim_proj _.
Next Obligation.
intros [σ HG]; simpl; apply HG.
Qed.
Program Definition lim_map (C : Cone T) : (cone_t T C : cmtyp) -n> (cone_t T lim_cone : cmtyp) :=
n[(fun m => exist _ (fun i => cone_m T C i m) _)].
Next Obligation.
intros n; simpl.
assert (HT := cone_m_com T C n m); apply HT.
Qed.
Lemma AllLimits : Limit T.
Proof.
refine (mkBaseLimit T lim_cone lim_map _ _).
+ intros C n x; simpl; reflexivity.
+ intros C h HCom x n; simpl.
specialize (HCom n x); simpl in HCom.
symmetry; apply HCom.
Qed.
End Limits.
End CBUlt.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
#############################################################################
## v # The Coq Proof Assistant ##
## <O___,, # INRIA - CNRS - LIX - LRI - PPS ##
## \VV/ # ##
## // # Makefile automagically generated by coq_makefile V8.4pl3 ##
#############################################################################
# WARNING
#
# This Makefile has been automagically generated
# Edit at your own risks !
#
# END OF WARNING
#
# This Makefile was generated by the command line :
# coq_makefile -R . RecDom BI.v CBUltInst.v CSetoid.v Constr.v Finmap.v MetricCore.v MetricRec.v PCBUltInst.v PCM.v Predom.v PreoMet.v TOTInst.v UPred.v -o Makefile
#
.DEFAULT_GOAL := all
#
# This Makefile may take arguments passed as environment variables:
# COQBIN to specify the directory where Coq binaries resides;
# ZDEBUG/COQDEBUG to specify debug flags for ocamlc&ocamlopt/coqc;
# DSTROOT to specify a prefix to install path.
# Here is a hack to make $(eval $(shell works:
define donewline
endef
includecmdwithout@ = $(eval $(subst @,$(donewline),$(shell { $(1) | tr -d '\r' | tr '\n' '@'; })))
$(call includecmdwithout@,$(COQBIN)coqtop -config)
##########################
# #
# Libraries definitions. #
# #
##########################
COQLIBS?= -R . RecDom
COQDOCLIBS?=-R . RecDom
##########################
# #
# Variables definitions. #
# #
##########################
OPT?=
COQDEP?=$(COQBIN)coqdep -c
COQFLAGS?=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML)
COQCHKFLAGS?=-silent -o
COQDOCFLAGS?=-interpolate -utf8
COQC?=$(COQBIN)coqc
GALLINA?=$(COQBIN)gallina
COQDOC?=$(COQBIN)coqdoc
COQCHK?=$(COQBIN)coqchk
##################
# #
# Install Paths. #
# #
##################
ifdef USERINSTALL
XDG_DATA_HOME?=$(HOME)/.local/share
COQLIBINSTALL=$(XDG_DATA_HOME)/coq
COQDOCINSTALL=$(XDG_DATA_HOME)/doc/coq
else
COQLIBINSTALL=${COQLIB}user-contrib
COQDOCINSTALL=${DOCDIR}user-contrib
endif
######################
# #
# Files dispatching. #
# #
######################
VFILES:=BI.v\
CBUltInst.v\
CSetoid.v\
Constr.v\
Finmap.v\
MetricCore.v\
MetricRec.v\
PCBUltInst.v\
PCM.v\
Predom.v\
PreoMet.v\
TOTInst.v\
UPred.v
-include $(addsuffix .d,$(VFILES))
.SECONDARY: $(addsuffix .d,$(VFILES))
VOFILES:=$(VFILES:.v=.vo)
GLOBFILES:=$(VFILES:.v=.glob)
VIFILES:=$(VFILES:.v=.vi)
GFILES:=$(VFILES:.v=.g)
HTMLFILES:=$(VFILES:.v=.html)
GHTMLFILES:=$(VFILES:.v=.g.html)
ifeq '$(HASNATDYNLINK)' 'true'
HASNATDYNLINK_OR_EMPTY := yes
else
HASNATDYNLINK_OR_EMPTY :=
endif
#######################################
# #
# Definition of the toplevel targets. #
# #
#######################################
all: $(VOFILES)
spec: $(VIFILES)
gallina: $(GFILES)
html: $(GLOBFILES) $(VFILES)
- mkdir -p html
$(COQDOC) -toc $(COQDOCFLAGS) -html $(COQDOCLIBS) -d html $(VFILES)
gallinahtml: $(GLOBFILES) $(VFILES)
- mkdir -p html
$(COQDOC) -toc $(COQDOCFLAGS) -html -g $(COQDOCLIBS) -d html $(VFILES)
all.ps: $(VFILES)
$(COQDOC) -toc $(COQDOCFLAGS) -ps $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`
all-gal.ps: $(VFILES)
$(COQDOC) -toc $(COQDOCFLAGS) -ps -g $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`
all.pdf: $(VFILES)
$(COQDOC) -toc $(COQDOCFLAGS) -pdf $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`
all-gal.pdf: $(VFILES)
$(COQDOC) -toc $(COQDOCFLAGS) -pdf -g $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`
validate: $(VOFILES)
$(COQCHK) $(COQCHKFLAGS) $(COQLIBS) $(notdir $(^:.vo=))
beautify: $(VFILES:=.beautified)
for file in $^; do mv $${file%.beautified} $${file%beautified}old && mv $${file} $${file%.beautified}; done
@echo 'Do not do "make clean" until you are sure that everything went well!'
@echo 'If there were a problem, execute "for file in $$(find . -name \*.v.old -print); do mv $${file} $${file%.old}; done" in your shell/'
.PHONY: all opt byte archclean clean install userinstall depend html validate
####################
# #
# Special targets. #
# #
####################
byte:
$(MAKE) all "OPT:=-byte"
opt:
$(MAKE) all "OPT:=-opt"
userinstall:
+$(MAKE) USERINSTALL=true install
install:
for i in $(VOFILES); do \
install -d `dirname $(DSTROOT)$(COQLIBINSTALL)/RecDom/$$i`; \
install -m 0644 $$i $(DSTROOT)$(COQLIBINSTALL)/RecDom/$$i; \
done
install-doc:
install -d $(DSTROOT)$(COQDOCINSTALL)/RecDom/html
for i in html/*; do \
install -m 0644 $$i $(DSTROOT)$(COQDOCINSTALL)/RecDom/$$i;\
done
clean:
rm -f $(VOFILES) $(VIFILES) $(GFILES) $(VFILES:.v=.v.d) $(VFILES:=.beautified) $(VFILES:=.old)
rm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob $(VFILES:.v=.glob) $(VFILES:.v=.tex) $(VFILES:.v=.g.tex) all-mli.tex
- rm -rf html mlihtml
archclean:
rm -f *.cmx *.o
printenv:
@$(COQBIN)coqtop -config
@echo CAMLC = $(CAMLC)
@echo CAMLOPTC = $(CAMLOPTC)
@echo PP = $(PP)
@echo COQFLAGS = $(COQFLAGS)
@echo COQLIBINSTALL = $(COQLIBINSTALL)
@echo COQDOCINSTALL = $(COQDOCINSTALL)
###################
# #
# Implicit rules. #
# #
###################
%.vo %.glob: %.v
$(COQC) $(COQDEBUG) $(COQFLAGS) $*
%.vi: %.v
$(COQC) -i $(COQDEBUG) $(COQFLAGS) $*
%.g: %.v
$(GALLINA) $<
%.tex: %.v
$(COQDOC) $(COQDOCFLAGS) -latex $< -o $@
%.html: %.v %.glob
$(COQDOC) $(COQDOCFLAGS) -html $< -o $@
%.g.tex: %.v
$(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@
%.g.html: %.v %.glob
$(COQDOC)$(COQDOCFLAGS) -html -g $< -o $@
%.v.d: %.v
$(COQDEP) -slash $(COQLIBS) "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} )
%.v.beautified:
$(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $*
# WARNING
#
# This Makefile has been automagically generated
# Edit at your own risks !
#
# END OF WARNING
This diff is collapsed.
This diff is collapsed.
(** This module provides the proof that PCBUlt, the category of
pre-ordered, complete, bisected ultrametric spaces, forms an
M-category. *)
Require Import PreoMet.
Require Import MetricRec.
Module PCBUlt <: MCat.
Local Obligation Tactic := intros; resp_set || mono_resp || eauto with typeclass_instances.
Definition M := pcmtyp.
Instance MArr : BC_morph M := fun U V => pcmFromType (U -m> V).
Program Instance MComp : BC_comp M := fun U V W => lift2m (lift2s pcomp _ _) _ _.
Instance MId : BC_id M := fun T => pid T.
Local Instance unit_preo : preoType unit := disc_preo unit.
Local Instance unit_pcm : pcmType unit := disc_pcm unit.
Instance MTermO : BC_term M := pcmFromType unit.
Program Instance MTermA : BC_terminal M := fun U => m[(const tt)].
Instance Cat : BaseCat M.
Proof.
split; intros; intros n; simpl; reflexivity || exact I.
Qed.
Section Limits.
Context (T : Tower).
Definition guard := fun (σ : forall i, tow_objs T i) => forall n, tow_morphs T n (σ (S n)) == σ n.
Instance lpg : LimitPreserving guard.
Proof.
intros σ σc HG n.
rewrite !dep_chain_compl.
rewrite nonexp_continuous; apply umet_complete_ext; intros k.
simpl; apply HG.
Qed.
Program Definition lim_obj : pcmtyp := pcmFromType {σ : forall i, tow_objs T i | guard σ}.
Definition lim_proj i : lim_obj -m> tow_objs T i := (pcmProjI i muincl)%pm.
Program Definition lim_cone : Cone T := mkBaseCone T lim_obj lim_proj _.
Next Obligation.
intros [σ HG]; simpl; apply HG.
Qed.
Program Definition lim_map (C : Cone T) : (cone_t T C : pcmtyp) -m> (cone_t T lim_cone : pcmtyp) :=
m[(fun m => exist _ (fun i => cone_m T C i m) _)].
Next Obligation.
intros n; simpl.
assert (HT := cone_m_com T C n m); apply HT.
Qed.
Lemma AllLimits : Limit T.
Proof.
refine (mkBaseLimit T lim_cone lim_map _ _).
+ intros C n x; simpl; reflexivity.
+ intros C h HCom x n; simpl.
specialize (HCom n x); simpl in HCom.
symmetry; apply HCom.
Qed.
End Limits.
End PCBUlt.
(** Partial commutative monoids. *)
Require Export Predom.
Require Import MetricCore.
Require Import PreoMet.
Class Associative {T} `{eqT : Setoid T} (op : T -> T -> T) :=
assoc : forall t1 t2 t3, op t1 (op t2 t3) == op (op t1 t2) t3.
Class Commutative {T} `{eqT : Setoid T} (op : T -> T -> T) :=
comm : forall t1 t2, op t1 t2 == op t2 t1.
Section Definitions.
Context (T : Type).
Local Instance eqT : Setoid T | 20000 := discreteType.
Class PCM_unit := pcm_unit : T.
Class PCM_op := pcm_op : option T -> option T -> option T.
Class PCM {TU : PCM_unit} {TOP : PCM_op} :=
mkPCM {
pcm_op_assoc :> Associative (eqT := discreteType) pcm_op;
pcm_op_comm :> Commutative (eqT := discreteType) pcm_op;
pcm_op_unit : forall t, pcm_op (Some pcm_unit) t = t;
pcm_op_zero : forall t, pcm_op None t = None
}.
End Definitions.
Notation "1" := (Some (pcm_unit _)) : pcm_scope.
Notation "0" := None : pcm_scope.
Notation "p · q" := (pcm_op _ p q) (at level 40, left associativity) : pcm_scope.
Delimit Scope pcm_scope with pcm.
(* PCMs with cartesian products of carriers. *)
Section Products.
Context S T `{pcmS : PCM S, pcmT : PCM T}.
Local Open Scope pcm_scope.
Local Existing Instance eqT.
Global Instance pcm_unit_prod : PCM_unit (S * T) := (pcm_unit S, pcm_unit T).
Global Instance pcm_op_prod : PCM_op (S * T) :=
fun ost1 ost2 =>
match ost1, ost2 with
| Some (s1, t1), Some (s2, t2) =>
match Some s1 · Some s2, Some t1 · Some t2 with
| Some sr, Some tr => Some (sr, tr)
| _, _ => None
end
| _, _ => None
end.
Global Instance pcm_prod : PCM (S * T).
Proof.
split.
- intros [[s1 t1] |]; [| reflexivity].
intros [[s2 t2] |]; [| reflexivity].
intros [[s3 t3] |];
[unfold pcm_op, pcm_op_prod |
unfold pcm_op at 1 2, pcm_op_prod;
destruct (Some (s1, t1) · Some (s2, t2)) as [[s t] |]; simpl; tauto].
assert (HS := assoc (Some s1) (Some s2) (Some s3));
assert (HT := assoc (Some t1) (Some t2) (Some t3)).
destruct (Some s1 · Some s2) as [s12 |];
destruct (Some s2 · Some s3) as [s23 |]; [.. | reflexivity].
+ destruct (Some t1 · Some t2) as [t12 |];
destruct (Some t2 · Some t3) as [t23 |]; [.. | reflexivity].
* simpl in HS, HT; rewrite HS, HT; reflexivity.
* erewrite comm, pcm_op_zero in HT by eassumption; simpl in HT.
rewrite <- HT; destruct (Some s12 · Some s3); reflexivity.
* erewrite pcm_op_zero in HT by eassumption; simpl in HT.
rewrite HT; destruct (Some s1 · Some s23); reflexivity.
+ erewrite comm, pcm_op_zero in HS by eassumption; simpl in HS.
destruct (Some t1 · Some t2) as [t12 |]; [| reflexivity].
rewrite <- HS; reflexivity.
+ erewrite pcm_op_zero in HS by eassumption; simpl in HS.
destruct (Some t2 · Some t3) as [t23 |]; [| reflexivity].
rewrite HS; reflexivity.
- intros [[s1 t1] |] [[s2 t2] |]; try reflexivity; []; simpl; unfold pcm_op, pcm_op_prod.
rewrite (comm (Some s1)); assert (HT := comm (Some t1) (Some t2)).
simpl in HT; rewrite HT; reflexivity.
- intros [[s t] |]; [| reflexivity]; unfold pcm_op, pcm_op_prod; simpl.
erewrite !pcm_op_unit by eassumption; reflexivity.
- intros st; reflexivity.
Qed.
End Products.
Section Order.
Context T `{pcmT : PCM T}.
Local Open Scope pcm_scope.
Local Existing Instance eqT.
Definition pcm_ord (t1 t2 : T) :=
exists ot, ot · Some t1 = Some t2.
Global Program Instance PCM_preo : preoType T := mkPOType pcm_ord.
Next Obligation.
split.
- intros x; exists 1; eapply pcm_op_unit; assumption.
- intros z yz xyz [y Hyz] [x Hxyz]; exists (x · y).
rewrite <- assoc; congruence.
Qed.
Local Existing Instance option_preo_top.
Global Instance prod_ord : Proper (pord ==> pord ==> pord) (pcm_op _).
Proof.
intros x1 x2 EQx y1 y2 EQy.
destruct x2 as [x2 |]; [| erewrite pcm_op_zero by eassumption; exact I].
destruct x1 as [x1 |]; [| contradiction]; destruct EQx as [x EQx].
destruct y2 as [y2 |]; [| erewrite (comm (Some x2)), pcm_op_zero by eassumption; exact I].
destruct y1 as [y1 |]; [| contradiction]; destruct EQy as [y EQy].
destruct (Some x2 · Some y2) as [xy2 |] eqn: EQxy2; [| exact I].
destruct (Some x1 · Some y1) as [xy1 |] eqn: EQxy1.
- exists (x · y); rewrite <- EQxy1.
rewrite <- assoc, (comm y), <- assoc, assoc, (comm (Some y1)); congruence.
- rewrite <- EQx, <- EQy in EQxy2.
rewrite <- assoc, (assoc (Some x1)), (comm (Some x1)), <- assoc in EQxy2.
erewrite EQxy1, (comm y), comm, !pcm_op_zero in EQxy2 by eassumption.
discriminate.
Qed.
End Order.
(* Package of a monoid as a module type (for use with other modules). *)
Module Type PCM_T.
Parameter res : Type.
Declare Instance res_op : PCM_op res.
Declare Instance res_unit : PCM_unit res.
Declare Instance res_pcm : PCM res.
End PCM_T.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
Require Export PreoMet.
Section Definitions.
Context {T} {pT : preoType T}.
Program Definition uniform (p : nat -> T -> Prop) :=
forall n m (t1 t2 : T) (HLe : m <= n) (HSub : t1 t2), p n t1 -> p m t2.
Record UPred :=
mkUPred {pred :> nat -> T -> Prop;
uni_pred : uniform pred }.
Program Definition up_cr (p : T -> Prop) {HP : Proper (pord ==> impl) p}:=
mkUPred (fun n t => p t) _.
Next Obligation. intros m n t1 t2 _ HT; simpl; rewrite HT; tauto. Qed.
Definition up_equiv (p q : UPred) := forall n t, p n t == q n t.
Global Program Instance up_type : Setoid UPred := mkType up_equiv.
Next Obligation.
split.
- intros p n t; reflexivity.
- intros p q Hpq n t; symmetry; apply Hpq.
- intros p q r Hpq Hqr n t; etransitivity; [apply Hpq | apply Hqr].
Qed.
Definition up_dist n (p q : UPred) :=
forall m t, m < n -> (p m t <-> q m t).
Global Program Instance up_metric : metric UPred := mkMetr up_dist.
Next Obligation.
intros p q Hpq r s Hrs; split; intros HD m t HLt; [symmetry in Hpq, Hrs |];
rewrite (Hpq m t), (Hrs m t); apply HD; assumption.
Qed.
Next Obligation.
split; intros HEq.
- intros n t; apply (HEq (S n)); auto with arith.
- intros _ m t _; apply HEq.
Qed.
Next Obligation.
intros p q Hpq m t HLt; symmetry; apply Hpq, HLt.
Qed.
Next Obligation.
intros p q r Hpq Hqr m t HLt; etransitivity; [apply Hpq, HLt | apply Hqr, HLt].
Qed.
Next Obligation.
intros m t HLt; apply H; auto with arith.
Qed.
Next Obligation.
intros m t HLt; inversion HLt.
Qed.
Program Definition up_compl (σ : chain UPred) (σc : cchain σ) :=
mkUPred (fun n t => σ (S n) n t) _.
Next Obligation.
intros n m t1 t2 HLt HSub HCn.
eapply (chain_cauchy σ σc (S m) (S n)); auto with arith; [].
eapply uni_pred; eassumption.
Qed.
Global Program Instance up_cmetric : cmetric UPred := mkCMetr up_compl.
Next Obligation.
intros n; exists n; intros i HLe k t HLt; simpl.
eapply (chain_cauchy σ σc (S k)); eauto with arith.
Qed.
Definition up_ord (p q : UPred) := forall n t, p n t -> q n t.
Global Program Instance up_preotype : preoType UPred := mkPOType up_ord.
Next Obligation.
split.
+ intros p n t; tauto.
+ intros p q r Hpq Hqr n t Hp; apply Hqr, Hpq, Hp.
Qed.
Global Instance up_pcmetric : pcmType UPred.
Proof.
split.
+ intros p q Hpq r s Hrs; split; intros Hpr n t Hq;
apply Hrs, Hpr, Hpq, Hq.
+ intros σ ρ σc ρc HSub n t Hpc; simpl in *; apply HSub, Hpc.
Qed.
Global Instance upred_equiv : Proper (equiv ==> eq ==> eq ==> iff) pred.
Proof.
add_morphism_tactic; intros R1 R2 EQR n t; split; intros HH; apply EQR; assumption.
Qed.
Global Instance upred_pord : Proper (pord ==> le --> pord ==> impl) pred.
Proof.
intros R1 R2 SubR n1 n2 Len t1 t2 Subt HR1; eapply SubR, uni_pred; eassumption.
Qed.
Definition laterF (p : nat -> T -> Prop) n t :=
match n with
| O => True
| S n => p n t
end.
Program Definition later_up (p : UPred) :=
mkUPred (laterF p) _.
Next Obligation.
intros [| m] [| n] t1 t2 HLe HSubt; simpl; try tauto; [now inversion HLe |].
intros HP; eapply uni_pred; [| eassumption | eassumption]; auto with arith.
Qed.
Global Instance later_up_equiv : Proper (equiv ==> equiv) later_up.
Proof.
intros P Q EQPQ [| n] t; simpl; [reflexivity | apply EQPQ].
Qed.
Global Instance later_up_dist n : Proper (dist n ==> dist n) later_up.
Proof.
intros P Q EQPQ [| k] t HLt; simpl; [reflexivity | apply EQPQ; auto with arith].
Qed.
Lemma equiv_upred_simpl U (R : relation U) (f : U -> UPred) {RS : Symmetric R}
(HP : forall u1 u2 n t, R u1 u2 -> f u1 n t -> f u2 n t) :
Proper (R ==> equiv) f.
Proof.
intros u1 u2 HRu; split; intros HF; (eapply HP; [| eassumption]);
[| symmetry]; assumption.
Qed.
Lemma dist_upred_simpl U (R : relation U) (f : U -> UPred) n {RS : Symmetric R}
(HP : forall u1 u2 m t (HLt : m < n), R u1 u2 -> f u1 m t -> f u2 m t) :
Proper (R ==> dist n) f.
Proof.
intros u1 u2 HRu m t HLt; split; intros HF;
(eapply HP; [eassumption | | eassumption]); [| symmetry]; assumption.
Qed.
Global Instance const_resp P : Proper (pord (T := T) ==> impl) (const P).
Proof. add_morphism_tactic; unfold impl; unfold const; tauto. Qed.
End Definitions.
Global Arguments UPred T {pT}.
Notation "▹ p" := (later_up p) (at level 20) : upred_scope.
Section Products.
Context {R S} {pR : preoType R} {pS : preoType S}.
Program Definition prod_up (p : UPred R) (q : UPred S) : UPred (R * S) :=
mkUPred (fun n rs => p n (fst rs) /\ q n (snd rs)) _.
Next Obligation.
intros n m [r1 s1] [r2 s2] HLe [Subr Subs] [HP HQ]; simpl in HP, HQ.
simpl; split; [rewrite <- Subr | rewrite <- Subs]; rewrite HLe; assumption.
Qed.
Global Instance prod_up_equiv : Proper (equiv ==> equiv ==> equiv) prod_up.
Proof.
intros p1 p2 EQp q1 q2 EQq n [r s]; simpl.
rewrite EQp, EQq; tauto.
Qed.
Global Instance prod_up_dist n : Proper (dist n ==> dist n ==> dist n) prod_up.
Proof.
intros p1 p2 EQp q1 q2 EQq m [r s] HLt; simpl.
split; intros [HP HQ]; (split; [apply EQp | apply EQq]); assumption.
Qed.
Global Instance prod_up_pord : Proper (pord ==> pord ==> pord) prod_up.
Proof.
intros p1 p2 Subp q1 q2 Subq n [r s]; simpl; intros [HP HQ].
split; [apply Subp | apply Subq]; assumption.
Qed.
End Products.