(** * Flat semi-lattice *)
(** Given a type with decidable equality [X], the following functor returns a semi-lattice structure over [X.t] complemented with a top and a bottom element.  The ordering is the flat ordering [Bot < Inj x < Top]. *)
Module LFlat(X: EQUALITY_TYPE) <: SEMILATTICE_WITH_TOP.
Inductive t' : Type :=
| Bot: t'
| Inj: X.t -> t'
| Top: t'.
Definition t : Type := t'.
Definition eq (x y: t) := (x = y).
Definition eq_refl: forall x, eq x x := (@eq_refl t).
Definition eq_sym: forall x y, eq x y -> eq y x := (@eq_sym t).
Definition eq_trans: forall x y z, eq x y -> eq y z -> eq x z := (@eq_trans t).
Definition beq (x y: t) : bool :=
match x, y with
| Bot, Bot => true
| Inj u, Inj v => if X.eq u v then true else false
| Top, Top => true
| _, _ => false
end.

(* Specifications: *)
Lemma beq_correct: forall x y, beq x y = true -> eq x y.
Definition ge (x y: t) : Prop :=
match x, y with
| Top, _ => True
| _, Bot => True
| Inj a, Inj b => a = b
| _, _ => False
end.
Lemma ge_refl: forall x y, eq x y -> ge x y.
Lemma ge_trans: forall x y z, ge x y -> ge y z -> ge x z.
Definition bot: t := Bot.
Lemma ge_bot: forall x, ge x bot.
Definition top: t := Top.
Lemma ge_top: forall x, ge top x.
Definition lub (x y: t) : t :=
match x, y with
| Bot, _ => y
| _, Bot => x
| Top, _ => Top
| _, Top => Top
| Inj a, Inj b => if X.eq a b then Inj a else Top
end.
Lemma ge_lub_left: forall x y, ge (lub x y) x.
Lemma ge_lub_right: forall x y, ge (lub x y) y.
End LFlat.
Lemma beq_correct: forall x y, beq x y = true -> eq x y.
Definition ge (x y: t) : Prop :=
match x, y with
| Top, _ => True
| _, Bot => True
| Inj a, Inj b => a = b
| _, _ => False
end.
Lemma ge_refl: forall x y, eq x y -> ge x y.
Lemma ge_trans: forall x y z, ge x y -> ge y z -> ge x z.
Definition bot: t := Bot.
Lemma ge_bot: forall x, ge x bot.
Definition top: t := Top.
Lemma ge_top: forall x, ge top x.
Definition lub (x y: t) : t :=
match x, y with
| Bot, _ => y
| _, Bot => x
| Top, _ => Top
| _, Top => Top
| Inj a, Inj b => if X.eq a b then Inj a else Top
end.
Lemma ge_lub_left: forall x y, ge (lub x y) x.
Lemma ge_lub_right: forall x y, ge (lub x y) y.
End LFlat.