Section BOOLEAN_ALGEBRA. (* Reference: << Constructive Completeness Proofs and Delimited Control >> written by "Danko Ilik" *)
Context {B : Type} {BA : isBA B}.
#[local] Notation andB := (@andB B BA).
Definition andsB : list B -> B :=
fold_right andB trueB.
Context {SETOID : isSetoid B}.
Definition leB (lhs : B) (rhs : B) : Prop :=
andB lhs rhs == lhs.
Context {BOOLEAN_ALGEBRA_LAWS : BooleanAlgebraLaws BA}.
#[global]
Instance leB_PreOrder
: PreOrder leB.
#[global]
Instance leB_PartialOrder
: PartialOrder eqProp leB.
#[global]
Instance BA_isProset : isProset B :=
{ leProp lhs rhs := andB lhs rhs == lhs
; Proset_isSetoid := SETOID
; leProp_PreOrder := leB_PreOrder
; leProp_PartialOrder := leB_PartialOrder
}.
#[global]
Instance andB_compathWith_leProp
: isMonotonic2 andB.
#[local] Hint Resolve andsB_le_In : core.
Variant isFilter (F : ensemble B) : Prop :=
| isFilter_if
(CLOSED_andsB : forall xs, L.is_finsubset_of xs F -> andsB xs \in F)
(CLOSED_UPWARD : forall x, x \in F -> forall x', x =< x' -> x' \in F)
: isFilter F.
#[global]
Add Parametric Morphism
: isFilter with signature (eqProp ==> iff)
as isFilter_eqProp_iff.
Definition inconsistent X : Prop :=
exists botB, botB \in X /\ botB == falseB.
#[global]
Add Parametric Morphism :
inconsistent with signature (eqProp ==> iff)
as inconsistent_compatWith_eqProp.
Definition isProperFilter F : Prop :=
⟪ IS_FILTER : isFilter F ⟫ /\ ⟪ CONSISTENT : ~ inconsistent F ⟫.
Definition equiconsistent X X' : Prop :=
inconsistent X <-> inconsistent X'.
#[global]
Instance equiconsistent_Equivalence : Equivalence equiconsistent :=
relation_on_image_liftsEquivalence iff_equivalence inconsistent.
#[global]
Add Parametric Morphism :
equiconsistent with signature (eqProp ==> eqProp ==> iff)
as equiconsistent_compatWith_eqProp.
Definition cl X : ensemble B :=
fun x => exists xs, ⟪ FINITE_SUBSET : L.is_finsubset_of xs X ⟫ /\ ⟪ andsB_LE : andsB xs =< x ⟫.
#[global]
Add Parametric Morphism :
cl with signature (eqProp ==> eqProp)
as cl_lifts_eqProp.
Proof with eauto with *.
eapply isFilter_intro.
- exists (trueB). exists ([]). unnw. split.
+ intros z z_in. inversion z_in.
+ rewrite andsB_zero...
- unfold cl. intros x1 x2 [xs1 ?] [xs2 ?]; des. exists (xs1 ++ xs2). unnw. split.
+ ii. rewrite L.in_app_iff in H. done!.
+ rewrite andsB_app. eapply andB_compathWith_leProp...
- intros x [xs ?] ? LE; des. exists (xs). unnw. split; [ | etransitivity]...
Qed.
Proof with eauto with *.
intros b b_in. exists ([b]). unnw. split.
- intros z [z_eq_b | []]; subst z...
- rewrite andsB_one...
Qed.

Lemma fact4_of_1_2_8 X X'
(X_isSubsetOf_X' : X \subseteq X')
: cl X \subseteq cl X'.