Commit d043dd23 by Paolo G. Giarrusso

### Reduce use of UIP as suggested by Robbert

parent fc9e8866
 ... @@ -1287,40 +1287,43 @@ Arguments sigO {_} _. ... @@ -1287,40 +1287,43 @@ Arguments sigO {_} _. (** Ofe for [sigT]. The first component must be discrete (** Ofe for [sigT]. The first component must be discrete and use Leibniz equality, while the second component might be any OFE. *) and use Leibniz equality, while the second component might be any OFE. *) Section sigmaT. Section sigT. Import EqNotations. Import EqNotations. Local Set Default Proof Using "Type*". (* For this construction we need UIP (Uniqueness of Identity Proofs) on [A] (i.e. [∀ x y : A, ProofIrrel (x = y)]. UIP is most commonly obtained from decidable equality (by Hedberg’s theorem, see [stdpp.proof_irrel.eq_pi]). *) Context {A : Type} `{!∀ a b : A, ProofIrrel (a = b)} {P : A → ofeT}. Context {A : Type} {P : A → ofeT}. Implicit Types x : sigT P. Implicit Types x : sigT P. (** (** The equality/distance for [{ a : A & P }] uses Leibniz equality on [A] to The distance for [{ a : A & P }] uses Leibniz equality on [A] to transport the second components to the same type, transport the second components to the same type, and then step-indexed equality/distance on the second component. and then step-indexed distance on the second component. Unlike in the topos of trees, with (C)OFEs we cannot use step-indexed equality Unlike in the topos of trees, with (C)OFEs we cannot use step-indexed equality on the first component. on the first component. *) *) Instance sigT_equiv : Equiv (sigT P) := λ x1 x2, ∃ eq : projT1 x1 = projT1 x2, rew eq in projT2 x1 ≡ projT2 x2. Instance sigT_dist : Dist (sigT P) := λ n x1 x2, Instance sigT_dist : Dist (sigT P) := λ n x1 x2, ∃ eq : projT1 x1 = projT1 x2, rew eq in projT2 x1 ≡{n}≡ projT2 x2. ∃ eq : projT1 x1 = projT1 x2, rew eq in projT2 x1 ≡{n}≡ projT2 x2. (** Usually we'd give a direct definition, and show it equivalent to [∀ n, x1 ≡{n}≡ x2] when proving the [equiv_dist] OFE axiom. But here the equivalence requires UIP — see [sigT_equiv_eq_alt]. By defining [equiv] in terms of [dist], we can define an OFE without assuming UIP, at the cost of complex reasoning on [equiv]. *) Instance sigT_equiv : Equiv (sigT P) := λ x1 x2, ∀ n, x1 ≡{n}≡ x2. (** Unfolding lemmas. (** Unfolding lemmas. Written with [↔] not [=] to avoid https://github.com/coq/coq/issues/3814. *) Written with [↔] not [=] to avoid https://github.com/coq/coq/issues/3814. *) Definition sigT_equiv_eq x1 x2 : (x1 ≡ x2) ↔ Definition sigT_equiv_eq x1 x2 : (x1 ≡ x2) ↔ ∀ n, x1 ≡{n}≡ x2 := ∃ eq : projT1 x1 = projT1 x2, rew eq in projT2 x1 ≡ projT2 x2 := reflexivity _. reflexivity _. Definition sigT_dist_eq x1 x2 n : (x1 ≡{n}≡ x2) ↔ Definition sigT_dist_eq x1 x2 n : (x1 ≡{n}≡ x2) ↔ ∃ eq : projT1 x1 = projT1 x2, rew eq in projT2 x1 ≡{n}≡ projT2 x2 := ∃ eq : projT1 x1 = projT1 x2, (rew eq in projT2 x1) ≡{n}≡ projT2 x2 := reflexivity _. reflexivity _. Definition sigT_equiv_proj1 x y : x ≡ y → projT1 x = projT1 y := proj1_ex. Definition sigT_dist_proj1 n {x y} : x ≡{n}≡ y → projT1 x = projT1 y := proj1_ex. Definition sigT_dist_proj1 n {x y} : x ≡{n}≡ y → projT1 x = projT1 y := proj1_ex. Definition sigT_equiv_proj1 x y : x ≡ y → projT1 x = projT1 y := λ H, proj1_ex (H 0). (** [existT] is "non-expansive". *) (** [existT] is "non-expansive". *) Lemma existT_ne n {i1 i2} {v1 : P i1} {v2 : P i2} : Lemma existT_ne n {i1 i2} {v1 : P i1} {v2 : P i2} : ... @@ -1328,17 +1331,15 @@ Section sigmaT. ... @@ -1328,17 +1331,15 @@ Section sigmaT. existT i1 v1 ≡{n}≡ existT i2 v2. existT i1 v1 ≡{n}≡ existT i2 v2. Proof. intros ->; simpl. exists eq_refl => /=. done. Qed. Proof. intros ->; simpl. exists eq_refl => /=. done. Qed. Lemma existT_proper {i1 i2} {v1 : P i1} {v2 : P i2} : ∀ (eq : i1 = i2), (rew f_equal P eq in v1 ≡ v2) → existT i1 v1 ≡ existT i2 v2. Proof. intros eq Heq n. apply (existT_ne n eq), equiv_dist, Heq. Qed. Definition sigT_ofe_mixin : OfeMixin (sigT P). Definition sigT_ofe_mixin : OfeMixin (sigT P). Proof. Proof. split. split => // n. - move => [x Px] [y Py] /=. - split; hnf; setoid_rewrite sigT_dist_eq. setoid_rewrite sigT_dist_eq; rewrite sigT_equiv_eq /=; split. + destruct 1 as [-> Heq]. exists eq_refl => /=. by apply equiv_dist. + intros Heq. destruct (Heq 0) as [-> _]. exists eq_refl => /=. apply equiv_dist => n. case: (Heq n) => [Hrefl]. have -> //=: Hrefl = eq_refl y. exact: proof_irrel. - move => n; split; hnf; setoid_rewrite sigT_dist_eq. + intros. by exists eq_refl. + intros. by exists eq_refl. + move => [xa x] [ya y] /=. destruct 1 as [-> Heq]. + move => [xa x] [ya y] /=. destruct 1 as [-> Heq]. by exists eq_refl. by exists eq_refl. ... @@ -1346,7 +1347,7 @@ Section sigmaT. ... @@ -1346,7 +1347,7 @@ Section sigmaT. destruct 1 as [-> Heq1]. destruct 1 as [-> Heq1]. destruct 1 as [-> Heq2]. exists eq_refl => /=. by trans y. destruct 1 as [-> Heq2]. exists eq_refl => /=. by trans y. - setoid_rewrite sigT_dist_eq. - setoid_rewrite sigT_dist_eq. move => n [xa x] [ya y] /=. destruct 1 as [-> Heq]. move => [xa x] [ya y] /=. destruct 1 as [-> Heq]. exists eq_refl. exact: dist_S. exists eq_refl. exact: dist_S. Qed. Qed. ... @@ -1356,9 +1357,8 @@ Section sigmaT. ... @@ -1356,9 +1357,8 @@ Section sigmaT. Global Instance sigT_discrete x : Discrete (projT2 x) → Discrete x. Global Instance sigT_discrete x : Discrete (projT2 x) → Discrete x. Proof. Proof. move: x => [xa x] ? [ya y]. move: x => [xa x] ? [ya y] [] /=; intros -> => /= Hxy n. rewrite sigT_dist_eq sigT_equiv_eq /=. destruct 1 as [-> Hxy]. exists eq_refl => /=. apply equiv_dist, (discrete _), Hxy. exists eq_refl. move: Hxy => /=. exact: discrete _. Qed. Qed. Global Instance sigT_ofe_discrete : (∀ a, OfeDiscrete (P a)) → OfeDiscrete sigTO. Global Instance sigT_ofe_discrete : (∀ a, OfeDiscrete (P a)) → OfeDiscrete sigTO. ... @@ -1367,24 +1367,39 @@ Section sigmaT. ... @@ -1367,24 +1367,39 @@ Section sigmaT. Lemma sigT_chain_const_proj1 c n : projT1 (c n) = projT1 (c 0). Lemma sigT_chain_const_proj1 c n : projT1 (c n) = projT1 (c 0). Proof. refine (sigT_dist_proj1 _ (chain_cauchy c 0 n _)). lia. Qed. Proof. refine (sigT_dist_proj1 _ (chain_cauchy c 0 n _)). lia. Qed. Program Definition chain_map_snd c : chain (P (projT1 (c 0))) := Lemma sigT_equiv_eq_alt `{!∀ a b : A, ProofIrrel (a = b)} x1 x2 : {| chain_car n := rew (sigT_chain_const_proj1 c n) in projT2 (c n) |}. x1 ≡ x2 ↔ Next Obligation. ∃ eq : projT1 x1 = projT1 x2, rew eq in projT2 x1 ≡ projT2 x2. move => c n i Hle /=. Proof. (* [Hgoal] is our thesis, up to casts: *) setoid_rewrite equiv_dist; setoid_rewrite sigT_dist_eq; split => Heq. case: (chain_cauchy c n i Hle) => [Heqin Hgoal] /=. - move: (Heq 0) => [H0eq1 _]. (* Pretty delicate. We have two casts to [projT1 (c 0)]. exists H0eq1 => n. move: (Heq n) => [] Hneq1. We replace those by one cast. *) by rewrite (proof_irrel H0eq1 Hneq1). move: (sigT_chain_const_proj1 c i) (sigT_chain_const_proj1 c n) - move: Heq => [Heq1 Heqn2] n. by exists Heq1. => Heqi0 Heqn0. (* Rewrite [projT1 (c 0)] to [projT1 (c n)] in goal and [Heqi0]: *) destruct Heqn0; cbn. have {Heqi0} -> /= : Heqi0 = Heqin; first exact: proof_irrel. exact Hgoal. Qed. Qed. (* For this COFE construction we need UIP (Uniqueness of Identity Proofs) on [A] (i.e. [∀ x y : A, ProofIrrel (x = y)]. UIP is most commonly obtained from decidable equality (by Hedberg’s theorem, see [stdpp.proof_irrel.eq_pi]). *) Section cofe. Section cofe. Context `{!∀ a, Cofe (P a)}. Context `{!∀ a b : A, ProofIrrel (a = b)} `{!∀ a, Cofe (P a)}. Program Definition chain_map_snd c : chain (P (projT1 (c 0))) := {| chain_car n := rew (sigT_chain_const_proj1 c n) in projT2 (c n) |}. Next Obligation. move => c n i Hle /=. (* [Hgoal] is our thesis, up to casts: *) case: (chain_cauchy c n i Hle) => [Heqin Hgoal] /=. (* Pretty delicate. We have two casts to [projT1 (c 0)]. We replace those by one cast. *) move: (sigT_chain_const_proj1 c i) (sigT_chain_const_proj1 c n) => Heqi0 Heqn0. (* Rewrite [projT1 (c 0)] to [projT1 (c n)] in goal and [Heqi0]: *) destruct Heqn0. by rewrite /= (proof_irrel Heqi0 Heqin). Qed. Definition sigT_compl : Compl sigTO := Definition sigT_compl : Compl sigTO := λ c, existT (projT1 (chain_car c 0)) (compl (chain_map_snd c)). λ c, existT (projT1 (chain_car c 0)) (compl (chain_map_snd c)). ... @@ -1398,12 +1413,12 @@ Section sigmaT. ... @@ -1398,12 +1413,12 @@ Section sigmaT. destruct (sigT_chain_const_proj1 c n); simpl. done. destruct (sigT_chain_const_proj1 c n); simpl. done. Qed. Qed. End cofe. End cofe. End sigmaT. End sigT. Arguments sigTO {_ _} _. Arguments sigTO {_} _. Section sigTOF. Section sigTOF. Context {A : Type} `{!∀ x y : A, ProofIrrel (x = y)} . Context {A : Type}. Program Definition sigT_map {P1 P2 : A → ofeT} : Program Definition sigT_map {P1 P2 : A → ofeT} : discrete_funO (λ a, P1 a -n> P2 a) -n> discrete_funO (λ a, P1 a -n> P2 a) -n> ... @@ -1425,10 +1440,10 @@ Section sigTOF. ... @@ -1425,10 +1440,10 @@ Section sigTOF. repeat intro. exists eq_refl => /=. solve_proper. repeat intro. exists eq_refl => /=. solve_proper. Qed. Qed. Next Obligation. Next Obligation. intros; exists eq_refl => /=. apply oFunctor_id. simpl; intros. apply (existT_proper eq_refl), oFunctor_id. Qed. Qed. Next Obligation. Next Obligation. intros; exists eq_refl => /=. apply oFunctor_compose. simpl; intros. apply (existT_proper eq_refl), oFunctor_compose. Qed. Qed. Global Instance sigTOF_contractive {F} : Global Instance sigTOF_contractive {F} : ... @@ -1437,7 +1452,7 @@ Section sigTOF. ... @@ -1437,7 +1452,7 @@ Section sigTOF. repeat intro. apply sigT_map => a. exact: oFunctor_contractive. repeat intro. apply sigT_map => a. exact: oFunctor_contractive. Qed. Qed. End sigTOF. End sigTOF. Arguments sigTOF {_ _} _%OF. Arguments sigTOF {_} _%OF. Notation "{ x & P }" := (sigTOF (λ x, P%OF)) : oFunctor_scope. Notation "{ x & P }" := (sigTOF (λ x, P%OF)) : oFunctor_scope. Notation "{ x : A & P }" := (@sigTOF A%type (λ x, P%OF)) : oFunctor_scope. Notation "{ x : A & P }" := (@sigTOF A%type (λ x, P%OF)) : oFunctor_scope.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!