Commit a123e160 authored by Robbert Krebbers's avatar Robbert Krebbers

Initial commit

parents
*.vo
*.glob
.sconsign.dblite
deps
old/*
coqidescript
\#*\#
*.pyc
*~
*.cmi
*.cmx
*.cmo
*.o
utils/coq2html
utils/coq2html.ml
doc/ch2o.*.html
*.cache
*.broken
broken/*
*.patch
parser/Extracted.*
parser/Lexer.ml
parser/Parser.ml
parser/Parser.mli
parser/Include.*
_build/
ch2o
*.native
*.byte
a.out
*.aux
.coq-native/
# Copyright (c) 2012-2015, Robbert Krebbers.
# This file is distributed under the terms of the BSD license.
import os, glob, string
modules = ["prelude", "iris"]
Rs = '-R . iris'
env = DefaultEnvironment(ENV = os.environ,tools=['default', 'Coq'], COQFLAGS=Rs)
# Coq dependencies
vs = [x for m in modules for x in glob.glob(m + '/*.v')]
if os.system('coqdep ' + Rs + ' ' + ' '.join(map(str, vs)) + ' > deps'): Exit(2)
ParseDepends('deps')
# Coq files
for v in vs: env.Coq(v)
# Coqidescript
env.CoqIdeScript('coqidescript', [])
Require Export cmra.
Local Hint Extern 10 (_ _) => omega.
Record agree A `{Dist A} := Agree {
agree_car :> nat A;
agree_is_valid : nat Prop;
agree_valid_0 : agree_is_valid 0;
agree_valid_S n : agree_is_valid (S n) agree_is_valid n;
agree_cauchy n i: n i agree_is_valid i agree_car n ={n}= agree_car i
}.
Arguments Agree {_ _} _ _ _ _ _.
Arguments agree_car {_ _} _ _.
Arguments agree_is_valid {_ _} _ _.
Arguments agree_cauchy {_ _} _ _ _ _ _.
Section agree.
Context `{Cofe A}.
Global Instance agree_validN : ValidN (agree A) := λ n x, agree_is_valid x n.
Lemma agree_valid_le (x : agree A) n n' : validN n x n' n validN n' x.
Proof. unfold validN, agree_validN; induction 2; eauto using agree_valid_S. Qed.
Global Instance agree_valid : Valid (agree A) := λ x, n, validN n x.
Global Instance agree_equiv : Equiv (agree A) := λ x y,
( n, validN n x validN n y) ( n, validN n x x n ={n}= y n).
Global Instance agree_dist : Dist (agree A) := λ n x y,
( n', n' n validN n' x validN n' y)
( n', n' n validN n' x x n' ={n'}= y n').
Global Program Instance agree_compl : Compl (agree A) := λ c,
{| agree_car n := c n n; agree_is_valid n := validN n (c n) |}.
Next Obligation. intros; apply agree_valid_0. Qed.
Next Obligation.
intros c n ?; apply (chain_cauchy c n (S n)), agree_valid_S; auto.
Qed.
Next Obligation.
intros c n i ??; simpl in *; rewrite <-(agree_cauchy (c i) n i) by done.
by apply (chain_cauchy c), (chain_cauchy c) with i, agree_valid_le with i.
Qed.
Instance agree_cofe : Cofe (agree A).
Proof.
split.
* intros x y; split.
+ by intros Hxy n; split; intros; apply Hxy.
+ by intros Hxy; split; intros; apply Hxy with n.
* split.
+ by split.
+ by intros x y Hxy; split; intros; symmetry; apply Hxy; auto; apply Hxy.
+ intros x y z Hxy Hyz; split; intros n'; intros.
- transitivity (validN n' y). by apply Hxy. by apply Hyz.
- transitivity (y n'). by apply Hxy. by apply Hyz, Hxy.
* intros n x y Hxy; split; intros; apply Hxy; auto.
* intros x y; split; intros n'; rewrite Nat.le_0_r; intros ->; [|done].
by split; intros; apply agree_valid_0.
* by intros c n; split; intros; apply (chain_cauchy c).
Qed.
Global Program Instance agree_op : Op (agree A) := λ x y,
{| agree_car := x; agree_is_valid n := validN n x validN n y x ={n}= y |}.
Next Obligation. by intros; simpl; split_ands; try apply agree_valid_0. Qed.
Next Obligation. naive_solver eauto using agree_valid_le, dist_S. Qed.
Next Obligation. by intros x y n i ? (?&?&?); apply agree_cauchy. Qed.
Global Instance agree_unit : Unit (agree A) := id.
Global Instance agree_minus : Minus (agree A) := λ x y, x.
Global Instance agree_included : Included (agree A) := λ x y, y x y.
Instance: Associative () (@op (agree A) _).
Proof.
intros x y z; split; [split|done].
* intros (?&(?&?&Hyz)&Hxy); repeat (intros (?&?&?) || intro || split);
eauto using agree_valid_le; try apply Hxy; auto.
etransitivity; [by apply Hxy|by apply Hyz].
* intros ((?&?&Hxy)&?&Hxz); repeat split;
try apply Hxy; eauto using agree_valid_le;
by etransitivity; [symmetry; apply Hxy|apply Hxz];
repeat (intro || split); eauto using agree_valid_le; apply Hxy; auto.
Qed.
Instance: Commutative () (@op (agree A) _).
Proof.
intros x y; split; [split|intros n (?&?&Hxy); apply Hxy; auto];
intros (?&?&Hxy); repeat split; eauto using agree_valid_le;
intros n' ??; symmetry; apply Hxy; eauto using agree_valid_le.
Qed.
Definition agree_idempotent (x : agree A) : x x x.
Proof. split; [split;[by intros (?&?&?)|done]|done]. Qed.
Instance: x : agree A, Proper (dist n ==> dist n) (op x).
Proof.
intros n x y1 y2 [Hy' Hy]; split; [|done].
split; intros (?&?&Hxy); repeat (intro || split);
try apply Hy'; eauto using agree_valid_le.
* etransitivity; [apply Hxy|apply Hy]; eauto using agree_valid_le.
* etransitivity; [apply Hxy|symmetry; apply Hy, Hy'];
eauto using agree_valid_le.
Qed.
Instance: Proper (dist n ==> dist n ==> dist n) op.
Proof. by intros n x1 x2 Hx y1 y2 Hy; rewrite Hy,!(commutative _ _ y2), Hx. Qed.
Global Instance agree_cmra : CMRA (agree A).
Proof.
split; try (apply _ || done).
* by intros n x y Hxy ?; apply Hxy.
* by intros n x1 x2 Hx y1 y2 Hy.
* by intros x y1 y2 Hy ?; do 2 red; rewrite <-Hy.
* intros; apply agree_valid_0.
* intros n x ?; apply agree_valid_le with (S n); auto.
* intros x; apply agree_idempotent.
* intros x y; change (x y x (x y)).
by rewrite (associative _), agree_idempotent.
* by intros x y n (?&?&?).
* by intros x y; do 2 red; rewrite (associative _), agree_idempotent.
Qed.
Program Definition to_agree (x : A) : agree A :=
{| agree_car n := x; agree_is_valid n := True |}.
Solve Obligations with done.
Global Instance to_agree_ne n : Proper (dist n ==> dist n) to_agree.
Proof. intros x1 x2 Hx; split; naive_solver eauto using @dist_le. Qed.
Lemma agree_op_inv (x y1 y2 : agree A) n :
validN n x x ={n}= y1 y2 y1 ={n}= y2.
Proof. by intros ? Hxy; apply Hxy. Qed.
Global Instance agree_extend : CMRAExtend (agree A).
Proof.
intros x y1 y2 n ? Hx; exists (x,x); simpl; split.
* by rewrite agree_idempotent.
* by rewrite Hx, (agree_op_inv x y1 y2), agree_idempotent by done.
Qed.
End agree.
Canonical Structure agreeC (A : cmraT) : cmraT := CMRAT (agree A).
Section agree_map.
Context `{Cofe A, Cofe B} (f: A B) `{Hf: n, Proper (dist n ==> dist n) f}.
Program Definition agree_map (x : agree A) : agree B :=
{| agree_car n := f (x n); agree_is_valid n := validN n x |}.
Next Obligation. apply agree_valid_0. Qed.
Next Obligation. by intros x n ?; apply agree_valid_S. Qed.
Next Obligation. by intros x n i ??; simpl; rewrite (agree_cauchy x n i). Qed.
Global Instance agree_map_ne n : Proper (dist n ==> dist n) agree_map.
Proof. by intros x1 x2 Hx; split; simpl; intros; [apply Hx|apply Hf, Hx]. Qed.
Global Instance agree_map_preserving : CMRAPreserving agree_map.
Proof.
split; [|by intros n ?].
intros x y; unfold included, agree_included; intros Hy; rewrite Hy.
split; [split|done].
* by intros (?&?&Hxy); repeat (intro || split);
try apply Hxy; try apply Hf; eauto using @agree_valid_le.
* by intros (?&(?&?&Hxy)&_); repeat split;
try apply Hxy; eauto using agree_valid_le.
Qed.
End agree_map.
Require Export excl.
Local Arguments disjoint _ _ !_ !_ /.
Local Arguments included _ _ !_ !_ /.
Record auth (A : Type) : Type := Auth { authorative : excl A ; own : A }.
Arguments Auth {_} _ _.
Arguments authorative {_} _.
Arguments own {_} _.
Notation "∘ x" := (Auth ExclUnit x) (at level 20).
Notation "∙ x" := (Auth (Excl x) ) (at level 20).
Instance auth_valid `{Valid A, Included A} : Valid (auth A) := λ x,
valid (authorative x) excl_above (own x) (authorative x).
Instance auth_equiv `{Equiv A} : Equiv (auth A) := λ x y,
authorative x authorative y own x own y.
Instance auth_unit `{Unit A} : Unit (auth A) := λ x,
Auth (unit (authorative x)) (unit (own x)).
Instance auth_op `{Op A} : Op (auth A) := λ x y,
Auth (authorative x authorative y) (own x own y).
Instance auth_minus `{Minus A} : Minus (auth A) := λ x y,
Auth (authorative x authorative y) (own x own y).
Instance auth_included `{Equiv A, Included A} : Included (auth A) := λ x y,
authorative x authorative y own x own y.
Instance auth_ra `{RA A} : RA (auth A).
Proof.
split.
* split.
+ by intros ?; split.
+ by intros ?? [??]; split.
+ intros ??? [??] [??]; split; etransitivity; eauto.
* by intros x y1 y2 [Hy Hy']; split; simpl; rewrite ?Hy, ?Hy'.
* by intros y1 y2 [Hy Hy']; split; simpl; rewrite ?Hy, ?Hy'.
* by intros y1 y2 [Hy Hy'] [??]; split; simpl; rewrite <-?Hy, <-?Hy'.
* by intros x1 x2 [Hx Hx'] y1 y2 [Hy Hy'];
split; simpl; rewrite ?Hy, ?Hy', ?Hx, ?Hx'.
* by intros x y1 y2 [Hy Hy'] [??]; split; simpl; rewrite <-?Hy, <-?Hy'.
* by split; simpl; rewrite (associative _).
* by split; simpl; rewrite (commutative _).
* by split; simpl; rewrite ?(ra_unit_l _).
* by split; simpl; rewrite ?(ra_unit_idempotent _).
* split; simpl; auto using ra_unit_weaken.
* intros ?? [??]; split; [by apply ra_valid_op_l with (authorative y)|].
by apply excl_above_weaken with (own x own y)
(authorative x authorative y); try apply ra_included_l.
* split; simpl; apply ra_included_l.
* by intros ?? [??]; split; simpl; apply ra_op_difference.
Qed.
Lemma auth_frag_op `{RA A} a b : (a b) a b.
Proof. done. Qed.
\ No newline at end of file
Require Export ra cofe cofe_instances.
Class ValidN (A : Type) := validN : nat A Prop.
Instance: Params (@validN) 3.
Class CMRA A `{Equiv A, Compl A,
Unit A, Op A, Valid A, ValidN A, Included A, Minus A} : Prop := {
(* setoids *)
cmra_cofe :> Cofe A;
cmra_op_ne n x :> Proper (dist n ==> dist n) (op x);
cmra_unit_ne n :> Proper (dist n ==> dist n) unit;
cmra_valid_ne n :> Proper (dist n ==> impl) (validN n);
cmra_minus_ne n :> Proper (dist n ==> dist n ==> dist n) minus;
cmra_included_proper x : Proper (() ==> impl) (included x);
(* valid *)
cmra_valid_0 x : validN 0 x;
cmra_valid_S n x : validN (S n) x validN n x;
cmra_valid_validN x : valid x n, validN n x;
(* monoid *)
cmra_associative : Associative () ();
cmra_commutative : Commutative () ();
cmra_unit_l x : unit x x x;
cmra_unit_idempotent x : unit (unit x) unit x;
cmra_unit_weaken x y : unit x unit (x y);
cmra_valid_op_l n x y : validN n (x y) validN n x;
cmra_included_l x y : x x y;
cmra_op_difference x y : x y x y x y
}.
Class CMRAExtend A `{Equiv A, Dist A, Op A, ValidN A} :=
cmra_extend_op x y1 y2 n :
validN n x x ={n}= y1 y2 { z | x z.1 z.2 z ={n}= (y1,y2) }.
Class CMRAPreserving
`{Included A, ValidN A, Included B, ValidN B} (f : A B) := {
included_preserving x y : x y f x f y;
validN_preserving n x : validN n x validN n (f x)
}.
(** Bundeled version *)
Structure cmraT := CMRAT {
cmra_car :> Type;
cmra_equiv : Equiv cmra_car;
cmra_dist : Dist cmra_car;
cmra_compl : Compl cmra_car;
cmra_unit : Unit cmra_car;
cmra_op : Op cmra_car;
cmra_valid : Valid cmra_car;
cmra_validN : ValidN cmra_car;
cmra_included : Included cmra_car;
cmra_minus : Minus cmra_car;
cmra_cmra : CMRA cmra_car;
cmra_extend : CMRAExtend cmra_car
}.
Arguments CMRAT _ {_ _ _ _ _ _ _ _ _ _ _}.
Add Printing Constructor cmraT.
Existing Instances cmra_equiv cmra_dist cmra_compl cmra_unit cmra_op
cmra_valid cmra_validN cmra_included cmra_minus cmra_cmra cmra_extend.
Coercion cmra_cofeC (A : cmraT) : cofeT := CofeT A.
Canonical Structure cmra_cofeC.
Section cmra.
Context `{cmra : CMRA A}.
Implicit Types x y z : A.
Global Instance cmra_valid_ne' : Proper (dist n ==> iff) (validN n).
Proof. by split; apply cmra_valid_ne. Qed.
Global Instance cmra_valid_proper : Proper (() ==> iff) (validN n).
Proof. by intros n x1 x2 Hx; apply cmra_valid_ne', equiv_dist. Qed.
Global Instance cmra_ra : RA A.
Proof.
split; try by (destruct cmra; eauto with typeclass_instances).
* by intros x1 x2 Hx; rewrite !cmra_valid_validN; intros ? n; rewrite <-Hx.
* intros x y; rewrite !cmra_valid_validN; intros ? n.
by apply cmra_valid_op_l with y.
Qed.
Lemma cmra_valid_op_r x y n : validN n (x y) validN n y.
Proof. rewrite (commutative _ x); apply cmra_valid_op_l. Qed.
Lemma cmra_valid_included x y n : validN n y x y validN n x.
Proof.
rewrite ra_included_spec; intros Hvalid [z Hy]; rewrite Hy in Hvalid.
eauto using cmra_valid_op_l.
Qed.
Lemma cmra_valid_le x n n' : validN n x n' n validN n' x.
Proof. induction 2; eauto using cmra_valid_S. Qed.
Global Instance ra_op_ne n : Proper (dist n ==> dist n ==> dist n) ().
Proof.
intros x1 x2 Hx y1 y2 Hy.
by rewrite Hy, (commutative _ x1), Hx, (commutative _ y2).
Qed.
Lemma cmra_included_dist_l x1 x2 x1' n :
x1 x2 x1' ={n}= x1 x2', x1' x2' x2' ={n}= x2.
Proof.
rewrite ra_included_spec; intros [z Hx2] Hx1; exists (x1' z); split.
apply ra_included_l. by rewrite Hx1, Hx2.
Qed.
Lemma cmra_unit_valid x n : validN n x validN n (unit x).
Proof. rewrite <-(cmra_unit_l x) at 1; apply cmra_valid_op_l. Qed.
End cmra.
(* Also via [cmra_cofe; cofe_equivalence] *)
Hint Cut [!*; ra_equivalence; cmra_ra] : typeclass_instances.
Require Export prelude.
Obligation Tactic := idtac.
(** Unbundeled version *)
Class Dist A := dist : nat relation A.
Instance: Params (@dist) 2.
Notation "x ={ n }= y" := (dist n x y)
(at level 70, n at next level, format "x ={ n }= y").
Hint Extern 0 (?x ={_}= ?x) => reflexivity.
Hint Extern 0 (_ ={_}= _) => symmetry; assumption.
Record chain (A : Type) `{Dist A} := {
chain_car :> nat A;
chain_cauchy n i : n i chain_car n ={n}= chain_car i
}.
Arguments chain_car {_ _} _ _.
Arguments chain_cauchy {_ _} _ _ _ _.
Class Compl A `{Dist A} := compl : chain A A.
Class Cofe A `{Equiv A, Compl A} := {
equiv_dist x y : x y n, x ={n}= y;
dist_equivalence n :> Equivalence (dist n);
dist_S n x y : x ={S n}= y x ={n}= y;
dist_0 x y : x ={0}= y;
conv_compl (c : chain A) n : compl c ={n}= c n
}.
Hint Extern 0 (_ ={0}= _) => apply dist_0.
Class Contractive `{Dist A, Dist B} (f : A -> B) :=
contractive n : Proper (dist n ==> dist (S n)) f.
(** Bundeled version *)
Structure cofeT := CofeT {
cofe_car :> Type;
cofe_equiv : Equiv cofe_car;
cofe_dist : Dist cofe_car;
cofe_compl : Compl cofe_car;
cofe_cofe : Cofe cofe_car
}.
Arguments CofeT _ {_ _ _ _}.
Add Printing Constructor cofeT.
Existing Instances cofe_equiv cofe_dist cofe_compl cofe_cofe.
(** General properties *)
Section cofe.
Context `{Cofe A}.
Global Instance cofe_equivalence : Equivalence (() : relation A).
Proof.
split.
* by intros x; rewrite equiv_dist.
* by intros x y; rewrite !equiv_dist.
* by intros x y z; rewrite !equiv_dist; intros; transitivity y.
Qed.
Global Instance dist_ne n : Proper (dist n ==> dist n ==> iff) (dist n).
Proof.
intros x1 x2 ? y1 y2 ?; split; intros.
* by transitivity x1; [done|]; transitivity y1.
* by transitivity x2; [done|]; transitivity y2.
Qed.
Global Instance dist_proper n : Proper (() ==> () ==> iff) (dist n).
Proof.
intros x1 x2 Hx y1 y2 Hy.
by rewrite equiv_dist in Hx, Hy; rewrite (Hx n), (Hy n).
Qed.
Global Instance dist_proper_2 n x : Proper (() ==> iff) (dist n x).
Proof. by apply dist_proper. Qed.
Lemma dist_le x y n n' : x ={n}= y n' n x ={n'}= y.
Proof. induction 2; eauto using dist_S. Qed.
Global Instance contractive_ne `{Cofe B} (f : A B) `{!Contractive f} n :
Proper (dist n ==> dist n) f | 100.
Proof. by intros x1 x2 ?; apply dist_S, contractive. Qed.
Global Instance ne_proper `{Cofe B} (f : A B)
`{! n, Proper (dist n ==> dist n) f} : Proper (() ==> ()) f | 100.
Proof. by intros x1 x2; rewrite !equiv_dist; intros Hx n; rewrite (Hx n). Qed.
Global Instance ne_proper_2 `{Cofe B, Cofe C} (f : A B C)
`{! n, Proper (dist n ==> dist n ==> dist n) f} :
Proper (() ==> () ==> ()) f | 100.
Proof.
unfold Proper, respectful; setoid_rewrite equiv_dist.
by intros x1 x2 Hx y1 y2 Hy n; rewrite Hx, Hy.
Qed.
Lemma compl_ne (c1 c2: chain A) n : c1 n ={n}= c2 n compl c1 ={n}= compl c2.
Proof. intros. by rewrite (conv_compl c1 n), (conv_compl c2 n). Qed.
Lemma compl_ext (c1 c2 : chain A) : ( i, c1 i c2 i) compl c1 compl c2.
Proof. setoid_rewrite equiv_dist; naive_solver eauto using compl_ne. Qed.
End cofe.
(** Fixpoint *)
Program Definition fixpoint_chain `{Cofe A} (f : A A) `{!Contractive f}
(x : A) : chain A := {| chain_car i := Nat.iter i f x |}.
Next Obligation.
intros A ???? f ? x n; induction n as [|n IH]; intros i ?; [done|].
destruct i as [|i]; simpl; try lia; apply contractive, IH; auto with lia.
Qed.
Program Definition fixpoint `{Cofe A} (f : A A) `{!Contractive f}
(x : A) : A := compl (fixpoint_chain f x).
Section fixpoint.
Context `{Cofe A} (f : A A) `{!Contractive f}.
Lemma fixpoint_unfold x : fixpoint f x f (fixpoint f x).
Proof.
apply equiv_dist; intros n; unfold fixpoint.
rewrite (conv_compl (fixpoint_chain f x) n).
by rewrite (chain_cauchy (fixpoint_chain f x) n (S n)) at 1 by lia.
Qed.
Lemma fixpoint_ne (g : A A) `{!Contractive g} x y n :
( z, f z ={n}= g z) fixpoint f x ={n}= fixpoint g y.
Proof.
intros Hfg; unfold fixpoint; rewrite (conv_compl (fixpoint_chain f x) n),
(conv_compl (fixpoint_chain g y) n).
induction n as [|n IH]; simpl in *; [done|].
rewrite Hfg; apply contractive, IH; auto using dist_S.
Qed.
Lemma fixpoint_proper (g : A A) `{!Contractive g} x :
( x, f x g x) fixpoint f x fixpoint g x.
Proof. setoid_rewrite equiv_dist; naive_solver eauto using fixpoint_ne. Qed.
End fixpoint.
(** Function space *)
Structure cofeMor (A B : cofeT) : Type := CofeMor {
cofe_mor_car :> A B;
cofe_mor_ne n : Proper (dist n ==> dist n) cofe_mor_car
}.
Arguments CofeMor {_ _} _ {_}.
Add Printing Constructor cofeMor.
Existing Instance cofe_mor_ne.
Instance cofe_mor_proper `(f : cofeMor A B) : Proper (() ==> ()) f := _.
Instance cofe_mor_equiv {A B : cofeT} : Equiv (cofeMor A B) := λ f g,
x, f x g x.
Instance cofe_mor_dist (A B : cofeT) : Dist (cofeMor A B) := λ n f g,
x, f x ={n}= g x.
Program Definition fun_chain `(c : chain (cofeMor A B)) (x : A) : chain B :=
{| chain_car n := c n x |}.
Next Obligation. intros A B c x n i ?. by apply (chain_cauchy c). Qed.
Program Instance cofe_mor_compl (A B : cofeT) : Compl (cofeMor A B) := λ c,
{| cofe_mor_car x := compl (fun_chain c x) |}.
Next Obligation.
intros A B c n x y Hxy.
rewrite (conv_compl (fun_chain c x) n), (conv_compl (fun_chain c y) n).
simpl; rewrite Hxy; apply (chain_cauchy c); lia.
Qed.
Instance cofe_mor_cofe (A B : cofeT) : Cofe (cofeMor A B).
Proof.
split.
* intros X Y; split; [intros HXY n k; apply equiv_dist, HXY|].
intros HXY k; apply equiv_dist; intros n; apply HXY.
* intros n; split.
+ by intros f x.
+ by intros f g ? x.
+ by intros f g h ?? x; transitivity (g x).
* by intros n f g ? x; apply dist_S.
* by intros f g x.
* intros c n x; simpl.
rewrite (conv_compl (fun_chain c x) n); apply (chain_cauchy c); lia.
Qed.
Instance cofe_mor_car_proper :
Proper (() ==> () ==> ()) (@cofe_mor_car A B).
Proof. intros A B f g Hfg x y Hx; rewrite Hx; apply Hfg. Qed.
Lemma cofe_mor_ext {A B} (f g : cofeMor A B) : f g x, f x g x.
Proof. done. Qed.
Canonical Structure cofe_mor (A B : cofeT) : cofeT := CofeT (cofeMor A B).
Infix "-n>" := cofe_mor (at level 45, right associativity).
(** Identity and composition *)
Definition cid {A} : A -n> A := CofeMor id.
Instance: Params (@cid) 1.
Definition ccompose {A B C}
(f : B -n> C) (g : A -n> B) : A -n> C := CofeMor (f g).
Instance: Params (@ccompose) 3.
Infix "◎" := ccompose (at level 40, left associativity).
Lemma ccompose_ne {A B C} (f1 f2 : B -n> C) (g1 g2 : A -n> B) n :
f1 ={n}= f2 g1 ={n}= g2 f1 g1 ={n}= f2 g2.
Proof. by intros Hf Hg x; simpl; rewrite (Hg x), (Hf (g2 x)). Qed.
(** Pre-composition as a functor *)
Local Instance ccompose_l_ne' {A B C} (f : B -n> A) n :
Proper (dist n ==> dist n) (λ g : A -n> C, g f).
Proof. by intros g1 g2 ?; apply ccompose_ne. Qed.
Definition ccompose_l {A B C} (f : B -n> A) : (A -n> C) -n> (B -n> C) :=
CofeMor (λ g : A -n> C, g f).
Instance ccompose_l_ne {A B C} : Proper (dist n ==> dist n) (@ccompose_l A B C).
Proof. by intros n f1 f2 Hf g x; apply ccompose_ne. Qed.
(** unit *)
Instance unit_dist : Dist unit := λ _ _ _, True.
Instance unit_compl : Compl unit := λ _, ().
Instance unit_cofe : Cofe unit.
Proof. by repeat split; try exists 0. Qed.
(** Product *)
Instance prod_dist `{Dist A, Dist B} : Dist (A * B) := λ n,
prod_relation (dist n) (dist n).
Program Definition fst_chain `{Dist A, Dist B} (c : chain (A * B)) : chain A :=
{| chain_car n := fst (c n) |}.
Next Obligation. by intros A ? B ? c n i ?; apply (chain_cauchy c n). Qed.
Program Definition snd_chain `{Dist A, Dist B} (c : chain (A * B)) : chain B :=
{| chain_car n := snd (c n) |}.
Next Obligation. by intros A ? B ? c n i ?; apply (chain_cauchy c n). Qed.
Instance prod_compl `{Compl A, Compl B} : Compl (A * B) := λ c,
(compl (fst_chain c), compl (snd_chain c)).
Instance prod_cofe `{Cofe A, Cofe B} : Cofe (A * B).
Proof.
split.
* intros x y; unfold dist, prod_dist, equiv, prod_equiv, prod_relation.
rewrite !equiv_dist; naive_solver.
* apply _.
* by intros n [x1 y1] [x2 y2] [??]; split; apply dist_S.
* by split.
* intros c n; split. apply (conv_compl (fst_chain c) n).
apply (conv_compl (snd_chain c) n).
Qed.
Canonical Structure prodC (A B : cofeT) : cofeT := CofeT (A * B).
Local Instance prod_map_ne `{Dist A, Dist A', Dist B, Dist B'} n :
Proper ((dist n ==> dist n) ==> (dist n ==> dist n) ==>
dist n ==> dist n) (@prod_map A A' B B').
Proof. by intros f f' Hf g g' Hg ?? [??]; split; [apply Hf|apply Hg]. Qed.
Definition prodC_map {A A' B B'} (f : A -n> A') (g : B -n> B') :
prodC A B -n> prodC A' B' := CofeMor (prod_map f g).
Instance prodC_map_ne {A A' B B'} n :
Proper (dist n ==> dist n ==> dist n) (@prodC_map A A' B B').
Proof. intros f f' Hf g g' Hg [??]; split; [apply Hf|apply Hg]. Qed.
Instance pair_ne `{Dist A, Dist B} :
Proper (dist n ==> dist n ==> dist n) (@pair A B) := _.
Instance fst_ne `{Dist A, Dist B} : Proper (dist n ==> dist n) (@fst A B) := _.
Instance snd_ne `{Dist A, Dist B} : Proper (dist n ==> dist n) (@snd A B) := _.
Typeclasses Opaque prod_dist.
Require Export cofe.
Require Import fin_maps pmap nmap zmap stringmap.
(** Discrete cofe *)
Section discrete_cofe.
Context `{Equiv A, @Equivalence A ()}.
Instance discrete_dist : Dist A := λ n x y,
match n with 0 => True | S n => x y end.
Instance discrete_compl `{Equiv A} : Compl A := λ c, c 1.
Instance discrete_cofe : Cofe A.
Proof.
split.
* intros x y; split; [by intros ? []|intros Hn; apply (Hn 1)].
* intros [|n]; [done|apply _].
* by intros [|n].
* done.
* intros c [|n]; [done|apply (chain_cauchy c 1 (S n)); lia].
Qed.
Definition discreteC : cofeT := CofeT A.
End discrete_cofe.