Library structures.DCPOs
Require Import Coq.Logic.Classical.
Require Import FunctionalExtensionality.
Require Import PropExtensionality.
Require Import ProofIrrelevance.
Require Import Program.
Require Import coqrel.LogicalRelations.
Require Import interfaces.Category.
Require Import interfaces.ConcreteCategory.
Require Import structures.Posets.
Require Import FunctionalExtensionality.
Require Import PropExtensionality.
Require Import ProofIrrelevance.
Require Import Program.
Require Import coqrel.LogicalRelations.
Require Import interfaces.Category.
Require Import interfaces.ConcreteCategory.
Require Import structures.Posets.
Directed-complete partial orders
Directed sets
Definition
Class Directed `{PartialOrder} {I} (x : I → P) :=
directed : ∀ i j, ∃ k, R (x i) (x k) ∧ R (x j) (x k).
Global Instance Empty_set_directed `{PartialOrder} (x : Empty_set → P) :
Directed x.
Global Instance unit_set_directed `{PartialOrder} (x : unit → P) :
Directed x.
Lemma pair_directed `{PartialOrder} (x y : P) :
R x y →
Directed (bool_rect _ y x).
Global Hint Extern 1 (Directed _) ⇒
eapply @pair_directed; assumption : typeclass_instances.
Lemma directed_apply {P Q R S} (f : P → Q) {I} (x : I → P) :
∀ HR : @PartialOrder P R,
∀ HQ : @PartialOrder Q S,
Monotonic f (R ++> S) →
Directed x →
Directed (fun i ⇒ f (x i)).
Global Hint Extern 5 (Directed (fun i ⇒ ?f (?x i))) ⇒
eapply @directed_apply : typeclass_instances.
DCPOs
Class DCPO (P : Type) :=
{
lce : relation P;
lce_po :> PartialOrder lce;
dsup : ∀ {I} (x : I → P) `{Hx: !Directed x}, P;
dsup_is_sup {I} (x : I → P) `{!Directed x} :> IsSup x (dsup x);
}.
Definition lct `{DCPO} x y :=
lce x y ∧ x ≠ y.
Lemma lct_not_lce `{DCPO} x y :
lct x y → ¬ lce y x.
Lemma dsup_ub `{DCPO} {I} (x : I → P) `{Dx : !Directed x} (i : I) :
lce (x i) (dsup x).
Lemma dsup_lub `{DCPO} {I} (x : I → P) `{Dx : !Directed x} (y : P) :
(∀ i, lce (x i) y) → lce (dsup x) y.
Binary case for dsup
Definition bset {A} (x y : A) : bool → A :=
bool_rect _ y x.
Lemma bset_natural {A B} (f : A → B) (x y : A) :
bset (f x) (f y) = fun i ⇒ f (bset x y i).
Pairs like the ones defined above are directed when
the two elements are related.
Lemma bset_directed_r `{DCPO} (x y : P) :
lce x y → Directed (bset x y).
Global Hint Extern 1 (Directed _) ⇒
apply @bset_directed_r; assumption : typeclass_instances.
Lemma bset_directed_l `{DCPO} (x y : P) :
lce y x → Directed (bset x y).
Global Hint Extern 1 (Directed _) ⇒
apply @bset_directed_l; assumption : typeclass_instances.
Moreover, the supremum is the largest of the two elements.
Lemma lce_dsup_r `{DCPO} (x y : P) `{Dxy: !Directed (bset x y)} :
lce x y → dsup (bset x y) = y.
Lemma lce_dsup_l `{DCPO} (x y : P) `{Dxy: !Directed (bset x y)} :
lce y x → dsup (bset x y) = x.
Section PROD_DCPO.
Context {P Q} `{Pdcpo : DCPO P} `{Qdcpo : DCPO Q}.
Global Instance prod_issup {I} (x : I → P × Q) (y : P × Q) :
IsSup (fun i ⇒ fst (x i)) (fst y) →
IsSup (fun i ⇒ snd (x i)) (snd y) →
IsSup x y.
End PROD_DCPO.
Global Hint Extern 2 (DCPO (?P × ?Q)) ⇒
eapply @prod_dcpo : typeclass_instances.
Global Hint Extern 1 (Directed (fun i ⇒ fst _)) ⇒
eapply @prod_directed_fst : typeclass_instances.
Global Hint Extern 1 (Directed (fun i ⇒ snd _)) ⇒
eapply @prod_directed_snd : typeclass_instances.
Section FORALL_DCPO.
Context {I} {P : I → Type} `{Pdcpo : ∀ i:I, DCPO (P i)}.
Obligation Tactic := cbn.
Global Instance forall_directed {J} (x : J → ∀ i:I, P i) (i : I) :
Directed x →
Directed (fun j ⇒ x j i).
Global Instance forall_issup {J} (x: J → ∀ i, P i) (y: ∀ i, P i) :
(∀ i, IsSup (fun j ⇒ x j i) (y i)) →
IsSup x y.
End FORALL_DCPO.
Global Hint Extern 1 (DCPO (∀ i, _)) ⇒
eapply @forall_dcpo : typeclass_instances.
Scott-continuous functions
Definition
Class ArityCondition (strict : bool) J :=
arity_condition : if strict then True else inhabited J.
Global Instance ac_strict_trivial J :
ArityCondition true J.
Global Instance ac_nonstrict_unit :
ArityCondition false unit.
Global Instance ac_nonstrict_bool :
ArityCondition false bool.
Global Instance ac_nonstrict_nat :
ArityCondition false nat.
Our definition states that the image of dsup x is the supremum
of the image of x. This way we don't need to involve the target
dsup operation, which is only defined when f x is directed.
The preservation of the "upper bound" condition is equivalent to
monotonicity; the "least" condition is just stated as-is.
Class ScottContinuous strict {A B} `{Adcpo: DCPO A} `{Bdcpo: DCPO B} (f: A → B) :=
{
sc_lce :>
Monotonic f (lce ++> lce);
sc_lub `{HJ : ArityCondition strict} (x: J → A) `{Dx: !Directed x} y:
(∀ j, lce (f (x j)) y) → lce (f (dsup x)) y;
}.
Any strict Scott-continuous functions is also non-strict Scott-continuous.
Lemma sc_weaken `(ScottContinuous true) :
ScottContinuous false f.
Global Hint Extern 1 (ScottContinuous false _) ⇒
eapply @sc_weaken : typeclass_instances.
The definition above is equivalent to this statement.
Because suprema are unique, this means dsup is preserved.
Context `{HJ : ArityCondition strict} (x : J → A) `{Dx: !Directed x}.
Lemma sc_dsup `{Dy: !Directed (fun i ⇒ f (x i))} :
f (dsup x) = dsup (fun i ⇒ f (x i)).
For maximum generality, the lemma above is stated in terms of
a pre-existing proof that the image set is directed, but when
rewriting we will often need the following instance.
Lemma sc_directed :
Directed (fun i ⇒ f (x i)).
End SC_SUP.
Global Hint Extern 2 (IsSup _ (?f ?a)) ⇒
eapply @sc_sup : typeclass_instances.
Global Hint Extern 2 (Directed (fun i ⇒ _)) ⇒
eapply @sc_directed : typeclass_instances.
Global Instance sc_id `{Adcpo : DCPO} strict :
ScottContinuous strict (fun a ⇒ a).
Global Instance sc_compose {A B C} `{DCPO A} `{DCPO B} `{DCPO C} {strict} :
∀ (g : B → C) (f : A → B),
ScottContinuous strict g →
ScottContinuous strict f →
ScottContinuous strict (fun a ⇒ g (f a)).
Module DCPO <: ConcreteCategory.
Class Structure (P : Type) : Type :=
structure_dcpo : DCPO P.
Global Hint Immediate structure_dcpo : typeclass_instances.
Global Hint Extern 1 (Structure _) ⇒ red : typeclass_instances.
Class Morphism {A B} `{Adcpo: DCPO A} `{Bdcpo: DCPO B} (f : A → B) :=
morphism_sc : ScottContinuous true f.
Global Hint Immediate morphism_sc : typeclass_instances.
Global Hint Extern 1 (Morphism _) ⇒ red : typeclass_instances.
Global Instance id_mor `{DCPO} :
Morphism (fun x ⇒ x).
Global Instance compose_mor :
∀ {A B C} `{DCPO A} `{DCPO B} `{DCPO C} (g: B → C) (f: A → B),
Morphism g →
Morphism f →
Morphism (fun x ⇒ g (f x)).
Include ConcreteCategoryTheory.
End DCPO.
Notation dcpo := DCPO.structured_set.
Free DCPO
Definition
Record carrier {A : Type} :=
{
is : A → Prop;
is_unique a b : is a → is b → a = b;
}.
Arguments carrier : clear implicits.
Program Definition emb {A} (a : A) : carrier A :=
{| is := eq a |}.
Program Definition ext {A} `{Pdc: DCPO} (f : A → P) (x : carrier A) : P :=
dsup (I := {a | is x a}) (fun a ⇒ f (`a)) (Hx := _).
Lemma ext_emb_r {A} `{DCPO} (f : A → P) (a : A) :
ext f (emb a) = f a.
Lemma ext_emb_l {A} (x : carrier A) :
ext emb x = x.
Lemma ext_ext {A B C} (g : B → carrier C) (f : A → carrier B) (x : carrier A) :
ext g (ext f x) = ext (fun b ⇒ ext g (f b)) x.
End FDC.
Notation fdc := FDC.carrier.
Fixed point constructions
Overview
Kleene fixed point
Approximation sequence
Fixpoint lfp_approx (n : nat) :=
match n with
| 0 ⇒ bot
| S p ⇒ f (lfp_approx p)
end.
Lemma lfp_approx_incr n :
lce (lfp_approx n) (lfp_approx (S n)).
Limit
Properties
Lemma lfp_fixed :
f lfp = lfp.
Lemma lfp_least (x : P) :
f x = x → lce lfp x.
Lemma lfp_least_prefixed (y : P) :
lce (f y) y → lce lfp y.
End LFP.
Unfortunately, in some applications the recursive processes
we wish to study fail Scott-continuity. This is especially true
in the context of concurrency and fair scheduling, which involve
infinite nondeterminism. In that case, even f^* ⊥ may not be
a fixed point yet, and further applications of f and taking
limits may be necessary. To account for this process we must
generalize the finite iterates f^n ⊥ from natural numbers n
to ordinal numbers α and a corresponding notion of
transfinite iterates f^α.
To index our new approximation sequence, we need
a representation of ordinal numbers. Ordinal numbers
generalize natural numbers by allowing the construction
of a least upper bound for any set of predecessor
("limit ordinals") as well as zero and successors.
Ordinal numbers
Definition
Definition U : Type := Type.
Inductive t :=
sup_succ {
ar : U;
pred : ar → t;
}.
Arguments sup_succ {ar}.
Note that le is not antisymmetric but defines a preorder.
There is an equivalence class in this preorder for each ordinal.
As expected, every ordinal is strictly greated than
its predecessors.
Ordinals are totally ordered. This property is important
because it means every increasing ord-indexed sequence in
a dcpo is directed and therefore has a sup.
We can also define the associated strict order.
Definition lt (α β : t) : Prop :=
∃ j, le α (pred β j).
Global Instance lt_le :
subrelation lt le.
Lemma lt_not_le α β :
lt α β ↔ ¬ le β α.
Lemma pred_lt α i :
lt (pred α i) α.
Lemma lt_le_r α β γ :
lt α β → le β γ → lt α γ.
Lemma lt_wf :
well_founded lt.
Ascending chains
The following predicate states that there exists
an α-chain ending in y.
Program Fixpoint rank (y : A) (Hy : Acc R y) : t :=
sup_succ (fun x : {x | R x y} ⇒ rank (` x) _).
Lemma rank_incr x y (Hxy : R x y) (Hx : Acc R x) (Hy : Acc R y) :
¬ le (rank y Hy) (rank x Hx).
Lemma max_chain_length α y Hy :
chain_to α y → le α (rank y Hy).
This means we can define an ordinal larger than any chain.
Definition not_a_chain_length (HR : well_founded R) :=
sup_succ (fun y ⇒ rank y (HR y)).
Lemma no_long_chain_to y HR :
¬ chain_to (not_a_chain_length HR) y.
End MAX_CHAINS.
End Ord.
Notation ord := Ord.t.
Tarsky-style fixed point
Specification
Fixpoint Approximant (α : ord) (y : P) : Prop :=
∃ x,
(∀ i, Approximant (Ord.pred α i) (x i)) ∧
IsSup (fun i ⇒ f (x i)) y.
Existing Class Approximant.
To show that they can be constructed, we must first
establish that the approximants increase with their
ordinal index.
Construction step
Record approximant {α : ord} :=
mka {
aval :> P;
aprop : Approximant α aval;
}.
Arguments approximant : clear implicits.
Arguments mka {_} _ {_}.
Fixpoint approx_construct (α : ord) : approximant α :=
mka (dsup (fun i ⇒ f (approx_construct (Ord.pred α i)))).
Notation approx α := (aval (approx_construct α)).
Based on this specification, we can show that the set
of approximants generated in this way is well-founded.
Record candidate : Ord.U :=
mkc {
cval :> P;
cprop : ∃ α, Approximant α cval;
}.
Definition lt (x y : candidate) :=
lct (cval x) (cval y).
Lemma lt_wf :
well_founded lt.
Definition lfp :=
approx (Ord.not_a_chain_length lt lt_wf).
Now we can show that this is indeed the least fixed point.
Lemma approx_postfixed `{Approximant} :
lce y (f y).
Lemma approx_below_prefixed `{Approximant} z :
lce (f z) z →
lce y z.
Lemma approx_unfold (α : ord) :
approx α = dsup (fun i ⇒ f (approx (Ord.pred α i))).
Lemma approx_stops (α : ord) (i : Ord.ar α) :
f (approx (Ord.pred α i)) = approx (Ord.pred α i) →
f (approx α) = approx α.
Lemma approx_chain α :
Ord.chain_to lt α (mkc (approx α) (ex_intro _ α (_ : Approximant α (approx α)))) ∨
f (approx α) = approx α.
Lemma lfp_fixed :
f lfp = lfp.
Lemma lfp_least_prefixed y :
lce (f y) y → lce lfp y.
Lemma lfp_least y :
f y = y → lce lfp y.
End TFP.
End TFP.
When f is Scott-continuous then the two constructions coincide.