(* Lecture 23 demonstrates two key concepts in Coq:
   1. Coinductive streams and stream operations
   2. The Knaster-Tarski fixed point theorem *)

Require Import List.
Import ListNotations.

(* Section 1: Infinite streams and operations on them *)
Section streams.
  (* A stream is an infinite sequence of values of type T.
     It has a head (current value) and tail (remaining infinite sequence) *)
  CoInductive stream (T : Type) : Type := {
    hd: T;
    tl: stream T
  }.

  (* Create an infinite stream that repeats a single value *)
  CoFixpoint repeat (x : nat) : stream nat := {|
    hd := x;
    tl := repeat x
  |}.

  (* Make head and tail functions easier to use by inferring type T *)
  Arguments hd {T} _.
  Arguments tl {T} _.

  (* Get the nth element of a stream *)
  Fixpoint lookup {T} (n : nat) (s : stream T) : T :=
    match n with
    | 0 => hd s
    | S n' => lookup n' (tl s)
    end.

  (* Example computation *)
  Compute lookup 21 (repeat 18).
= 18
: nat

  (* Create a stream from a function mapping natural numbers to values *)
  CoFixpoint from_function {T} (f : nat -> T) : stream T := {|
    hd := f 0;
    tl := from_function (fun n => f (S n))
  |}.

  (* Looking up the nth element of a stream created from function f
     gives the same result as applying f to n directly *)
  Lemma lookup_from_function {T} (f : nat -> T) n : lookup n (from_function f) = f n.
T: Type
f: nat -> T
n: nat
lookup n (from_function f) = f n
  Proof.
T: Type
f: nat -> T
n: nat
lookup n (from_function f) = f n
    revert f.
T: Type
n: nat
forall f : nat -> T, lookup n (from_function f) = f n
    induction n; intros; simpl.
T: Type
f: nat -> T
f 0 = f 0
T: Type
n: nat
IHn: forall f : nat -> T, lookup n (from_function f) = f n
f: nat -> T
lookup n (from_function (fun n : nat => f (S n))) =
f (S n)
    -
T: Type
f: nat -> T
f 0 = f 0 reflexivity.
    -
T: Type
n: nat
IHn: forall f : nat -> T, lookup n (from_function f) = f n
f: nat -> T
lookup n (from_function (fun n : nat => f (S n))) =
f (S n) apply IHn.
  Qed.

  (* Pointwise addition of two streams of natural numbers *)
  CoFixpoint add_stream (s1 s2 : stream nat) : stream nat := {|
    hd := hd s1 + hd s2;
    tl := add_stream (tl s1) (tl s2)
  |}.

  (* Limits of Coq's productivity checker *)
  (* This definition fails because Coq can't see that the definition is productive due to the add_stream call. *)
  Fail CoFixpoint mult_stream (s1 s2 : stream nat) : stream nat := {|
    hd := hd s1 * hd s2;
    tl := add_stream (mult_stream (tl s1) s2) (mult_stream s1 (tl s2))
  |}.
The command has indeed failed with message:
Recursive definition of mult_stream is ill-formed.
In environment
mult_stream : stream nat -> stream nat -> stream nat
s1 : stream nat
s2 : stream nat
Unguarded recursive call in
"cofix add_stream (s1 s2 : stream nat) : stream nat :=
   {|
     hd := hd s1 + hd s2;
     tl := add_stream (tl s1) (tl s2)
   |}".
Recursive definition is:
"fun s1 s2 : stream nat =>
 {|
   hd := hd s1 * hd s2;
   tl :=
     add_stream (mult_stream (tl s1) s2)
       (mult_stream s1 (tl s2))
 |}".

  (* Coinductive definition of stream equality - two streams are equal if
     their heads are equal and their tails are equal *)
  CoInductive stream_eq {T} (s1 s2 : stream T) : Prop := {
    head_eq : hd s1 = hd s2;
    tail_eq : stream_eq (tl s1) (tl s2)
  }.

  (* Stream equality is reflexive *)
  Lemma stream_eq_refl {T} (s : stream T) : stream_eq s s.
T: Type
s: stream T
stream_eq s s
  Proof.
T: Type
s: stream T
stream_eq s s
    revert s.
T: Type
forall s : stream T, stream_eq s s
    cofix IH.
T: Type
IH: forall s : stream T, stream_eq s s
forall s : stream T, stream_eq s s
    intros s.
T: Type
IH: forall s : stream T, stream_eq s s
s: stream T
stream_eq s s
    constructor.
T: Type
IH: forall s : stream T, stream_eq s s
s: stream T
hd s = hd s
T: Type
IH: forall s : stream T, stream_eq s s
s: stream T
stream_eq (tl s) (tl s)
    -
T: Type
IH: forall s : stream T, stream_eq s s
s: stream T
hd s = hd s reflexivity.
    -
T: Type
IH: forall s : stream T, stream_eq s s
s: stream T
stream_eq (tl s) (tl s) apply IH.
  Qed.

  (* Adding two constant streams gives a constant stream with the sum *)
  Lemma add_stream_repeat n m : stream_eq (add_stream (repeat n) (repeat m)) (repeat (n + m)).
n, m: nat
stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m))
  Proof.
n, m: nat
stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m))
    cofix IH.
n, m: nat
IH: stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m))
stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m))
    constructor.
n, m: nat
IH: stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m))
hd (add_stream (repeat n) (repeat m)) =
hd (repeat (n + m))
n, m: nat
IH: stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m))
stream_eq (tl (add_stream (repeat n) (repeat m)))
  (tl (repeat (n + m)))
    -
n, m: nat
IH: stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m))
hd (add_stream (repeat n) (repeat m)) =
hd (repeat (n + m)) simpl.
n, m: nat
IH: stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m))
n + m = n + m reflexivity.
    -
n, m: nat
IH: stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m))
stream_eq (tl (add_stream (repeat n) (repeat m)))
  (tl (repeat (n + m))) simpl.
n, m: nat
IH: stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m))
stream_eq (add_stream (repeat n) (repeat m))
  (repeat (n + m)) apply IH.
  Qed.

  (* Converting a stream to a function and back gives the same stream *)
  Lemma from_function_lookup {T} (s : stream T) : 
    stream_eq (from_function (fun n => lookup n s)) s.
T: Type
s: stream T
stream_eq (from_function (fun n : nat => lookup n s))
  s
  Proof.
T: Type
s: stream T
stream_eq (from_function (fun n : nat => lookup n s))
  s
    revert s.
T: Type
forall s : stream T,
stream_eq (from_function (fun n : nat => lookup n s))
  s
    cofix IH.
T: Type
IH: forall s : stream T,
stream_eq
  (from_function (fun n : nat => lookup n s)) s
forall s : stream T,
stream_eq (from_function (fun n : nat => lookup n s))
  s
    intros s.
T: Type
IH: forall s : stream T,
stream_eq
  (from_function (fun n : nat => lookup n s)) s
s: stream T
stream_eq (from_function (fun n : nat => lookup n s))
  s
    constructor.
T: Type
IH: forall s : stream T,
stream_eq
  (from_function (fun n : nat => lookup n s)) s
s: stream T
hd (from_function (fun n : nat => lookup n s)) = hd s
T: Type
IH: forall s : stream T,
stream_eq
  (from_function (fun n : nat => lookup n s)) s
s: stream T
stream_eq
  (tl (from_function (fun n : nat => lookup n s)))
  (tl s)
    -
T: Type
IH: forall s : stream T,
stream_eq
  (from_function (fun n : nat => lookup n s)) s
s: stream T
hd (from_function (fun n : nat => lookup n s)) = hd s simpl.
T: Type
IH: forall s : stream T,
stream_eq
  (from_function (fun n : nat => lookup n s)) s
s: stream T
hd s = hd s reflexivity.
    -
T: Type
IH: forall s : stream T,
stream_eq
  (from_function (fun n : nat => lookup n s)) s
s: stream T
stream_eq
  (tl (from_function (fun n : nat => lookup n s)))
  (tl s) simpl.
T: Type
IH: forall s : stream T,
stream_eq
  (from_function (fun n : nat => lookup n s)) s
s: stream T
stream_eq
  (from_function (fun n : nat => lookup n (tl s)))
  (tl s) apply IH.
  Qed.
End streams.

(* Section 2: The Knaster-Tarski fixed point theorem and complete lattices *)
Section knaster_tarski.
  (* A set is modeled as a predicate - a function from A to Prop *)
  Definition set (A : Type) := A -> Prop.

  (* A lattice consists of:
     - A partial order relation (le)
     - A least upper bound operation (cup) *)
  Class Lattice (L : Type) := {
    le : L -> L -> Prop;
    cup : set L -> L;
  }.

  (* Convenient notation for le *)
  Notation "x <= y" := (le x y).

  (* Laws that a lattice must satisfy *)
  Class LatticeLaws (L : Type) `{Lattice L} := {
    le_refl : forall x, x <= x;                                (* Reflexivity *)
    le_trans : forall x y z, x <= y -> y <= z -> x <= z;      (* Transitivity *)
    le_asym : forall x y, x <= y -> y <= x -> x = y;          (* Antisymmetry *)

    le_cup : forall (X : set L) y, X y -> y <= (cup X);       (* cup is an upper bound *)
    cup_le : forall (X : set L) y, (forall x, X x -> x <= y) -> cup X <= y (* cup is least *)
  }.

  (* Hints for automation *)
  Local Hint Resolve le_refl le_asym le_cup cup_le : lat.
  Local Hint Extern 1 (?x <= ?y) => eapply le_trans; [solve [eauto 2]|] : lat.
  Local Hint Extern 1 (?x <= ?y) => eapply le_trans; [|solve [eauto 2]] : lat.

  (* Greatest lower bound operation defined in terms of cup *)
  Definition cap {L} `{Lattice L} (X : set L) : L := 
    cup (fun y => forall x, X x -> y <= x).

  (* cap is a lower bound *)
  Lemma cap_le {L} `{LatticeLaws L} (X : set L) y : X y -> cap X <= y.
L: Type
H: Lattice L
H0: LatticeLaws L
X: set L
y: L
X y -> cap X <= y
  Proof.
L: Type
H: Lattice L
H0: LatticeLaws L
X: set L
y: L
X y -> cap X <= y
    unfold cap.
L: Type
H: Lattice L
H0: LatticeLaws L
X: set L
y: L
X y ->
cup (fun y : L => forall x : L, X x -> y <= x) <= y eauto with lat.
  Qed.

  (* cap is the greatest lower bound *)
  Lemma le_cap {L} `{LatticeLaws L} (X : set L) y : 
    (forall x, X x -> y <= x) -> y <= cap X.
L: Type
H: Lattice L
H0: LatticeLaws L
X: set L
y: L
(forall x : L, X x -> y <= x) -> y <= cap X
  Proof.
L: Type
H: Lattice L
H0: LatticeLaws L
X: set L
y: L
(forall x : L, X x -> y <= x) -> y <= cap X
    unfold cap.
L: Type
H: Lattice L
H0: LatticeLaws L
X: set L
y: L
(forall x : L, X x -> y <= x) ->
y <= cup (fun y : L => forall x : L, X x -> y <= x) eauto with lat.
  Qed.

  Local Hint Resolve cap_le le_cap : lat.

  (* The powerset lattice - sets ordered by inclusion *)
  Global Instance set_lattice (T : Type) : Lattice (set T) := {
    le x y := forall t, x t -> y t;
    cup X := fun t => exists x, X x /\ x t
  }.

  (* Axioms needed for function and proposition extensionality *)
  Axiom funext : forall {T U} (f g : T -> U), (forall x, f x = g x) -> f = g.
  Axiom propext : forall P Q : Prop, (P <-> Q) -> P = Q.

  (* Prove that set_lattice satisfies the lattice laws *)
  Global Instance set_lattice_laws (T : Type) : LatticeLaws (set T).
T: Type
LatticeLaws (set T)
  Proof.
T: Type
LatticeLaws (set T)
    constructor; unfold le, cup; simpl; eauto.
T: Type
forall x y : set T,
(forall t : T, x t -> y t) ->
(forall t : T, y t -> x t) -> x = y
T: Type
forall (X : set (set T)) (y : set T),
(forall x : set T, X x -> forall t : T, x t -> y t) ->
forall t : T, (exists x : set T, X x /\ x t) -> y t
    -
T: Type
forall x y : set T,
(forall t : T, x t -> y t) ->
(forall t : T, y t -> x t) -> x = y intros.
T: Type
x, y: set T
H: forall t : T, x t -> y t
H0: forall t : T, y t -> x t
x = y apply funext.
T: Type
x, y: set T
H: forall t : T, x t -> y t
H0: forall t : T, y t -> x t
forall x0 : T, x x0 = y x0 intro.
T: Type
x, y: set T
H: forall t : T, x t -> y t
H0: forall t : T, y t -> x t
x0: T
x x0 = y x0 apply propext.
T: Type
x, y: set T
H: forall t : T, x t -> y t
H0: forall t : T, y t -> x t
x0: T
x x0 <-> y x0 split; eauto.
    -
T: Type
forall (X : set (set T)) (y : set T),
(forall x : set T, X x -> forall t : T, x t -> y t) ->
forall t : T, (exists x : set T, X x /\ x t) -> y t intros.
T: Type
X: set (set T)
y: set T
H: forall x : set T, X x -> forall t : T, x t -> y t
t: T
H0: exists x : set T, X x /\ x t
y t destruct H0 as [? []].
T: Type
X: set (set T)
y: set T
H: forall x : set T, X x -> forall t : T, x t -> y t
t: T
x: set T
H0: X x
H1: x t
y t eauto.
  Qed.

  (* A function is monotone if it preserves order *)
  Definition mono {L} `{Lattice L} (f : L -> L) := 
    forall x y, x <= y -> f x <= f y.

  (* omega contains all the iterates of f - both limits and successors *)
  Inductive omega {L} `{Lattice L} (f : L -> L) : set L :=
    | omega_lim (X : set L) : (forall x, X x -> omega f x) -> omega f (cup X)
    | omega_suc x : omega f x -> omega f (f x).

  Hint Constructors omega : lat.

  (* For monotone functions, elements of omega increase under f *)
  Lemma omega_incr {L} `{LatticeLaws L} (f : L -> L) x : 
    mono f -> omega f x -> x <= f x.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
mono f -> omega f x -> x <= f x
  Proof.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
mono f -> omega f x -> x <= f x
    intros Hmono HO.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
HO: omega f x
x <= f x induction HO.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
Hmono: mono f
X: set L
H1: forall x : L, X x -> omega f x
H2: forall x : L, X x -> x <= f x
cup X <= f (cup X)
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
Hmono: mono f
x: L
HO: omega f x
IHHO: x <= f x
f x <= f (f x)
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
Hmono: mono f
X: set L
H1: forall x : L, X x -> omega f x
H2: forall x : L, X x -> x <= f x
cup X <= f (cup X) eauto with lat.
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
Hmono: mono f
x: L
HO: omega f x
IHHO: x <= f x
f x <= f (f x) eauto with lat.
  Qed.

  Local Hint Resolve omega_incr : lat.

  (* cup omega is a fixed point *)
  Lemma omega_fix {L} `{LatticeLaws L} (f : L -> L) : 
    mono f -> f (cup (omega f)) = cup (omega f).
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
mono f -> f (cup (omega f)) = cup (omega f)
  Proof.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
mono f -> f (cup (omega f)) = cup (omega f)
    eauto 7 with lat.
  Qed.

  (* cup omega is the least fixed point *)
  Lemma omega_lfp {L} `{LatticeLaws L} (f : L -> L) x : 
    mono f -> f x <= x -> cup (omega f) <= x.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
mono f -> f x <= x -> cup (omega f) <= x
  Proof.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
mono f -> f x <= x -> cup (omega f) <= x
    intros Hmono Hle.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: f x <= x
cup (omega f) <= x eapply cup_le.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: f x <= x
forall x0 : L, omega f x0 -> x0 <= x intros y Hy.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: f x <= x
y: L
Hy: omega f y
y <= x
    induction Hy.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: f x <= x
X: set L
H1: forall x : L, X x -> omega f x
H2: forall x0 : L, X x0 -> x0 <= x
cup X <= x
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: f x <= x
x0: L
Hy: omega f x0
IHHy: x0 <= x
f x0 <= x
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: f x <= x
X: set L
H1: forall x : L, X x -> omega f x
H2: forall x0 : L, X x0 -> x0 <= x
cup X <= x eauto with lat.
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: f x <= x
x0: L
Hy: omega f x0
IHHy: x0 <= x
f x0 <= x eauto with lat.
  Qed.

  (* Induction principle for omega *)
  Lemma omega_ind' {L} `{LatticeLaws L} (f : L -> L) :
    forall P : L -> Prop,
    (forall X : set L, (forall x : L, X x -> omega f x) -> (forall x : L, X x -> P x) -> P (cup X)) ->
    (forall x : L, omega f x -> P x -> P (f x)) -> P (cup (omega f)).
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
forall P : L -> Prop,
(forall X : set L,
 (forall x : L, X x -> omega f x) ->
 (forall x : L, X x -> P x) -> P (cup X)) ->
(forall x : L, omega f x -> P x -> P (f x)) ->
P (cup (omega f))
  Proof.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
forall P : L -> Prop,
(forall X : set L,
 (forall x : L, X x -> omega f x) ->
 (forall x : L, X x -> P x) -> P (cup X)) ->
(forall x : L, omega f x -> P x -> P (f x)) ->
P (cup (omega f))
    intros P Hlim Hsuc.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> omega f x) ->
(forall x : L, X x -> P x) -> P (cup X)
Hsuc: forall x : L, omega f x -> P x -> P (f x)
P (cup (omega f))
    eapply Hlim.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> omega f x) ->
(forall x : L, X x -> P x) -> P (cup X)
Hsuc: forall x : L, omega f x -> P x -> P (f x)
forall x : L, omega f x -> omega f x
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> omega f x) ->
(forall x : L, X x -> P x) -> P (cup X)
Hsuc: forall x : L, omega f x -> P x -> P (f x)
forall x : L, omega f x -> P x {
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> omega f x) ->
(forall x : L, X x -> P x) -> P (cup X)
Hsuc: forall x : L, omega f x -> P x -> P (f x)
forall x : L, omega f x -> omega f x eauto. }
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> omega f x) ->
(forall x : L, X x -> P x) -> P (cup X)
Hsuc: forall x : L, omega f x -> P x -> P (f x)
forall x : L, omega f x -> P x
    intros x Hx.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> omega f x) ->
(forall x : L, X x -> P x) -> P (cup X)
Hsuc: forall x : L, omega f x -> P x -> P (f x)
x: L
Hx: omega f x
P x
    induction Hx.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> omega f x) ->
(forall x : L, X x -> P x) -> P (cup X)
Hsuc: forall x : L, omega f x -> P x -> P (f x)
X: set L
H1: forall x : L, X x -> omega f x
H2: forall x : L, X x -> P x
P (cup X)
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> omega f x) ->
(forall x : L, X x -> P x) -> P (cup X)
Hsuc: forall x : L, omega f x -> P x -> P (f x)
x: L
Hx: omega f x
IHHx: P x
P (f x)
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> omega f x) ->
(forall x : L, X x -> P x) -> P (cup X)
Hsuc: forall x : L, omega f x -> P x -> P (f x)
X: set L
H1: forall x : L, X x -> omega f x
H2: forall x : L, X x -> P x
P (cup X) eauto.
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> omega f x) ->
(forall x : L, X x -> P x) -> P (cup X)
Hsuc: forall x : L, omega f x -> P x -> P (f x)
x: L
Hx: omega f x
IHHx: P x
P (f x) eauto.
  Qed.

  (* Now the same, but for the greatest fixed point *)

  Inductive Omega {L} `{Lattice L} (f : L -> L) : set L :=
    | Omega_lim (X : set L) : (forall x, X x -> Omega f x) -> Omega f (cap X)
    | Omega_suc x : Omega f x -> Omega f (f x).

  Hint Constructors Omega : lat.

  (* For monotone functions, elements of Omega decrease under f *)
  Lemma Omega_decr {L} `{LatticeLaws L} (f : L -> L) x : 
    mono f -> Omega f x -> f x <= x.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
mono f -> Omega f x -> f x <= x
  Proof.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
mono f -> Omega f x -> f x <= x
    intros Hmono HO.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
HO: Omega f x
f x <= x induction HO.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
Hmono: mono f
X: set L
H1: forall x : L, X x -> Omega f x
H2: forall x : L, X x -> f x <= x
f (cap X) <= cap X
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
Hmono: mono f
x: L
HO: Omega f x
IHHO: f x <= x
f (f x) <= f x
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
Hmono: mono f
X: set L
H1: forall x : L, X x -> Omega f x
H2: forall x : L, X x -> f x <= x
f (cap X) <= cap X eauto with lat.
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
Hmono: mono f
x: L
HO: Omega f x
IHHO: f x <= x
f (f x) <= f x eauto with lat.
  Qed.

  Local Hint Resolve Omega_decr : lat.

  (* cap Omega is a fixed point *)
  Lemma Omega_fix {L} `{LatticeLaws L} (f : L -> L) : 
    mono f -> f (cap (Omega f)) = cap (Omega f).
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
mono f -> f (cap (Omega f)) = cap (Omega f)
  Proof.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
mono f -> f (cap (Omega f)) = cap (Omega f)
    eauto 7 with lat.
  Qed.

  (* cap Omega is the greatest fixed point *)
  Lemma Omega_gfp {L} `{LatticeLaws L} (f : L -> L) x : 
    mono f -> x <= f x -> x <= cap (Omega f).
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
mono f -> x <= f x -> x <= cap (Omega f)
  Proof.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
mono f -> x <= f x -> x <= cap (Omega f)
    intros Hmono Hle.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: x <= f x
x <= cap (Omega f) eapply le_cap.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: x <= f x
forall x0 : L, Omega f x0 -> x <= x0 intros y Hy.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: x <= f x
y: L
Hy: Omega f y
x <= y
    induction Hy.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: x <= f x
X: set L
H1: forall x : L, X x -> Omega f x
H2: forall x0 : L, X x0 -> x <= x0
x <= cap X
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: x <= f x
x0: L
Hy: Omega f x0
IHHy: x <= x0
x <= f x0
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: x <= f x
X: set L
H1: forall x : L, X x -> Omega f x
H2: forall x0 : L, X x0 -> x <= x0
x <= cap X eauto with lat.
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
x: L
Hmono: mono f
Hle: x <= f x
x0: L
Hy: Omega f x0
IHHy: x <= x0
x <= f x0 eauto with lat.
  Qed.

  Local Hint Resolve Omega_fix Omega_gfp : lat.

  (* Induction principle for Omega *)
  Lemma Omega_ind' {L} `{LatticeLaws L} (f : L -> L) :
    forall P : L -> Prop,
    (forall X : set L, (forall x, X x -> Omega f x) -> (forall x, X x -> P x) -> P (cap X)) ->
    (forall x : L, Omega f x -> P x -> P (f x)) -> P (cap (Omega f)).
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
forall P : L -> Prop,
(forall X : set L,
 (forall x : L, X x -> Omega f x) ->
 (forall x : L, X x -> P x) -> P (cap X)) ->
(forall x : L, Omega f x -> P x -> P (f x)) ->
P (cap (Omega f))
  Proof.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
forall P : L -> Prop,
(forall X : set L,
 (forall x : L, X x -> Omega f x) ->
 (forall x : L, X x -> P x) -> P (cap X)) ->
(forall x : L, Omega f x -> P x -> P (f x)) ->
P (cap (Omega f))
    intros P Hlim Hsuc.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> Omega f x) ->
(forall x : L, X x -> P x) -> P (cap X)
Hsuc: forall x : L, Omega f x -> P x -> P (f x)
P (cap (Omega f))
    eapply Hlim.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> Omega f x) ->
(forall x : L, X x -> P x) -> P (cap X)
Hsuc: forall x : L, Omega f x -> P x -> P (f x)
forall x : L, Omega f x -> Omega f x
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> Omega f x) ->
(forall x : L, X x -> P x) -> P (cap X)
Hsuc: forall x : L, Omega f x -> P x -> P (f x)
forall x : L, Omega f x -> P x {
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> Omega f x) ->
(forall x : L, X x -> P x) -> P (cap X)
Hsuc: forall x : L, Omega f x -> P x -> P (f x)
forall x : L, Omega f x -> Omega f x eauto. }
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> Omega f x) ->
(forall x : L, X x -> P x) -> P (cap X)
Hsuc: forall x : L, Omega f x -> P x -> P (f x)
forall x : L, Omega f x -> P x
    intros x Hx.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> Omega f x) ->
(forall x : L, X x -> P x) -> P (cap X)
Hsuc: forall x : L, Omega f x -> P x -> P (f x)
x: L
Hx: Omega f x
P x
    induction Hx.
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> Omega f x) ->
(forall x : L, X x -> P x) -> P (cap X)
Hsuc: forall x : L, Omega f x -> P x -> P (f x)
X: set L
H1: forall x : L, X x -> Omega f x
H2: forall x : L, X x -> P x
P (cap X)
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> Omega f x) ->
(forall x : L, X x -> P x) -> P (cap X)
Hsuc: forall x : L, Omega f x -> P x -> P (f x)
x: L
Hx: Omega f x
IHHx: P x
P (f x)
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> Omega f x) ->
(forall x : L, X x -> P x) -> P (cap X)
Hsuc: forall x : L, Omega f x -> P x -> P (f x)
X: set L
H1: forall x : L, X x -> Omega f x
H2: forall x : L, X x -> P x
P (cap X) eauto.
    -
L: Type
H: Lattice L
H0: LatticeLaws L
f: L -> L
P: L -> Prop
Hlim: forall X : set L,
(forall x : L, X x -> Omega f x) ->
(forall x : L, X x -> P x) -> P (cap X)
Hsuc: forall x : L, Omega f x -> P x -> P (f x)
x: L
Hx: Omega f x
IHHx: P x
P (f x) eauto.
  Qed.

End knaster_tarski.