Library HeytingAndKripke

Require Export PropL.

Record HeytingAlgebra : Type :=
  mkHeytingAlgebra {
      H:Type;
      R: H -> H -> Prop;
      bot: H;
      top: H;
      meet: H -> H -> H;
      join: H -> H -> H;
      imp: H -> H -> H;
      Rref : forall w, R w w;
      Rtra : forall u v w, R u v -> R v w -> R u w;
      bot1 : forall u, R bot u;
      top1 : forall u, R u top;
      meet1 : forall u v, R (meet u v) u;
      meet2 : forall u v, R (meet u v) v;
      meet3 : forall u v w, R w u -> R w v -> R w (meet u v);
      join1 : forall u v, R u (join u v);
      join2 : forall u v, R v (join u v);
      join3 : forall u v w, R u w -> R v w -> R (join u v) w;
      imp1 : forall u v, R (meet (imp u v) u) v;
      imp2 : forall u v w, R (meet w u) v -> R w (imp u v)
}.

Section HeytingAlgebra.
  Variable HA : HeytingAlgebra.

  Variable interp : var -> H HA.

  Fixpoint evalH (s : form) : H HA :=
    match s with
      | Var x => interp x
      | Fal => bot HA
      | Imp s t => imp (evalH s) (evalH t)
    end.

  Fixpoint evalH' (A : list form) : H HA :=
    match A with
      | nil => top HA
      | s::A => meet (evalH' A) (evalH s)
    end.

  Lemma nd_soundH A s : nd A s -> R (evalH' A) (evalH s).

End HeytingAlgebra.

Section HeytingHa5.

  Inductive Ha5 : Type := Ha5bot | Ha5ab | Ha5a | Ha5b | Ha5top.

  Definition Ha5R (a b : Ha5) : Prop :=
    match a,b with
      | Ha5bot,_ => True
      | _,Ha5bot => False
      | _,Ha5top => True
      | Ha5top,_ => False
      | Ha5a, Ha5a => True
      | Ha5a, Ha5b => False
      | Ha5a, Ha5ab => False
      | Ha5b, Ha5a => False
      | Ha5b, Ha5b => True
      | Ha5b, Ha5ab => False
      | Ha5ab, Ha5a => True
      | Ha5ab, Ha5b => True
      | Ha5ab, Ha5ab => True
    end.

  Definition Ha5meet (a b : Ha5) : Ha5 :=
    match a,b with
      | Ha5bot,_ => Ha5bot
      | _,Ha5bot => Ha5bot
      | Ha5top,b => b
      | a,Ha5top => a
      | Ha5a, Ha5a => Ha5a
      | Ha5a, Ha5b => Ha5ab
      | Ha5a, Ha5ab => Ha5ab
      | Ha5b, Ha5a => Ha5ab
      | Ha5b, Ha5b => Ha5b
      | Ha5b, Ha5ab => Ha5ab
      | Ha5ab, Ha5a => Ha5ab
      | Ha5ab, Ha5b => Ha5ab
      | Ha5ab, Ha5ab => Ha5ab
    end.

  Definition Ha5join (a b : Ha5) : Ha5 :=
    match a,b with
      | Ha5top,_ => Ha5top
      | _,Ha5top => Ha5top
      | Ha5bot,b => b
      | a,Ha5bot => a
      | Ha5a, Ha5a => Ha5a
      | Ha5a, Ha5b => Ha5top
      | Ha5a, Ha5ab => Ha5a
      | Ha5b, Ha5a => Ha5top
      | Ha5b, Ha5b => Ha5b
      | Ha5b, Ha5ab => Ha5b
      | Ha5ab, Ha5a => Ha5a
      | Ha5ab, Ha5b => Ha5b
      | Ha5ab, Ha5ab => Ha5ab
    end.

  Definition Ha5imp (a b : Ha5) : Ha5 :=
    match a,b with
      | Ha5bot, _ => Ha5top
      | _, Ha5top => Ha5top
      | Ha5a, Ha5bot => Ha5bot
      | Ha5a, Ha5a => Ha5top
      | Ha5a, Ha5b => Ha5b
      | Ha5a, Ha5ab => Ha5b
      | Ha5b, Ha5bot => Ha5bot
      | Ha5b, Ha5a => Ha5a
      | Ha5b, Ha5b => Ha5top
      | Ha5b, Ha5ab => Ha5a
      | Ha5ab, Ha5bot => Ha5bot
      | Ha5ab, Ha5a => Ha5top
      | Ha5ab, Ha5b => Ha5top
      | Ha5ab, Ha5ab => Ha5top
      | Ha5top, Ha5bot => Ha5bot
      | Ha5top, Ha5a => Ha5a
      | Ha5top, Ha5b => Ha5b
      | Ha5top, Ha5ab => Ha5ab
    end.

  Lemma Ha5Rref a : Ha5R a a.

  Lemma Ha5Rtra a b c : Ha5R a b -> Ha5R b c -> Ha5R a c.

  Definition Ha5HA : HeytingAlgebra.
  Defined.

  Definition Ha5interp (x : var) : Ha5 :=
  match x with
    | O => Ha5a
    | S _ => Ha5b
  end.

  Let Ha5eval := @evalH Ha5HA Ha5interp.

  Lemma undef_a_And_b u : Ha5eval u <> Ha5ab.

End HeytingHa5.

Section HeytingHb5.

  Inductive Hb5 : Type := Hb5bot | Hb5a | Hb5b | Hb5ab | Hb5top.

  Definition Hb5R (a b : Hb5) : Prop :=
    match a,b with
      | Hb5bot,_ => True
      | _,Hb5bot => False
      | _,Hb5top => True
      | Hb5top,_ => False
      | Hb5a, Hb5a => True
      | Hb5a, Hb5b => False
      | Hb5a, Hb5ab => True
      | Hb5b, Hb5a => False
      | Hb5b, Hb5b => True
      | Hb5b, Hb5ab => True
      | Hb5ab, Hb5a => False
      | Hb5ab, Hb5b => False
      | Hb5ab, Hb5ab => True
    end.

  Definition Hb5meet (a b : Hb5) : Hb5 :=
    match a,b with
      | Hb5bot,_ => Hb5bot
      | _,Hb5bot => Hb5bot
      | Hb5top,b => b
      | a,Hb5top => a
      | Hb5a, Hb5a => Hb5a
      | Hb5a, Hb5b => Hb5bot
      | Hb5a, Hb5ab => Hb5a
      | Hb5b, Hb5a => Hb5bot
      | Hb5b, Hb5b => Hb5b
      | Hb5b, Hb5ab => Hb5b
      | Hb5ab, Hb5a => Hb5a
      | Hb5ab, Hb5b => Hb5b
      | Hb5ab, Hb5ab => Hb5ab
    end.

  Definition Hb5imp (a b : Hb5) : Hb5 :=
    match a,b with
      | Hb5bot, _ => Hb5top
      | _, Hb5top => Hb5top
      | Hb5a, Hb5bot => Hb5b
      | Hb5a, Hb5a => Hb5top
      | Hb5a, Hb5b => Hb5b
      | Hb5a, Hb5ab => Hb5top
      | Hb5b, Hb5bot => Hb5a
      | Hb5b, Hb5a => Hb5a
      | Hb5b, Hb5b => Hb5top
      | Hb5b, Hb5ab => Hb5top
      | Hb5ab, Hb5bot => Hb5bot
      | Hb5ab, Hb5a => Hb5a
      | Hb5ab, Hb5b => Hb5b
      | Hb5ab, Hb5ab => Hb5top
      | Hb5top, Hb5bot => Hb5bot
      | Hb5top, Hb5a => Hb5a
      | Hb5top, Hb5b => Hb5b
      | Hb5top, Hb5ab => Hb5ab
    end.

  Definition Hb5join (a b : Hb5) : Hb5 :=
    match a,b with
      | Hb5bot,b => b
      | a,Hb5bot => a
      | Hb5top,_ => Hb5top
      | _,Hb5top => Hb5top
      | _, Hb5ab => Hb5ab
      | Hb5ab, _ => Hb5ab
      | Hb5a, Hb5a => Hb5a
      | Hb5a, Hb5b => Hb5ab
      | Hb5b, Hb5a => Hb5ab
      | Hb5b, Hb5b => Hb5b
    end.

  Lemma Hb5Rref a : Hb5R a a.

  Lemma Hb5Rtra a b c : Hb5R a b -> Hb5R b c -> Hb5R a c.

  Definition Hb5HA : HeytingAlgebra.
  Defined.

  Definition Hb5interp (x : var) : Hb5 :=
  match x with
    | O => Hb5a
    | S _ => Hb5b
  end.

  Let Hb5eval := @evalH Hb5HA Hb5interp.

  Lemma undef_a_Or_b u : Hb5eval u <> Hb5ab.

End HeytingHb5.

Record KripkeModel : Type :=
  mkKripkeModel {
      state : Type;
      step : state -> state -> Prop;
      pred := state -> Prop;
      label : nat -> pred;
      label_mon : forall a b n, step a b -> label n a -> label n b;
      step_refl : forall a, step a a;
      step_trans : forall a b c, step a b -> step b c -> step a c
    }.

Section KripkeModel.

  Variable M:KripkeModel.

  Fixpoint evalK (s:form) : pred M :=
    match s with
      | Var n => label n
      | Fal => fun _ => False
      | Imp s1 s2 => fun w => forall w', step w w' -> evalK s1 w' -> evalK s2 w'
    end.

  Lemma monotone (s:form) : forall w w', @step M w w' -> evalK s w -> evalK s w'.

  Definition evalK' (A:context) : pred M := fun w => forall s, s el A -> evalK s w.

  Lemma monotone_ctx (A:context) : forall w w', @step M w w' -> evalK' A w -> evalK' A w'.

  Lemma nd_soundK (A:context) (s:form) (D:nd A s) : forall w, evalK' A w -> evalK s w.

End KripkeModel.

Section KripkeModelToHeytingAlgebra.
  Variable M : KripkeModel.

  Let Cl : (state M -> Prop) -> Prop := fun p => forall u v : state M, step u v -> p u -> p v.

  Let H:Type := {p:state M -> Prop | Cl p}.
  Let R: H -> H -> Prop := fun a b => let (p,_) := a in let (q,_) := b in forall u, p u -> q u.

  Let bot: H.
  Defined.

  Let top: H.
  Defined.

  Let meet: H -> H -> H.
  Defined.

  Let imp: H -> H -> H.
  Defined.

  Let join: H -> H -> H.
  Defined.

  Definition HeytingAlgebraOfKripkeModel : HeytingAlgebra.
  Defined.

  Definition HeytingInterpOfKripkeModel : var -> H.
  Defined.

  Theorem evalK_evalH_agree s :
    let (X,_) := @evalH HeytingAlgebraOfKripkeModel HeytingInterpOfKripkeModel s in
    forall w : state M, evalK s w <-> X w.

End KripkeModelToHeytingAlgebra.

Section HeytingAlgebraToKripkeModel.
  Variable A : HeytingAlgebra.

  Definition ProperFilter (F:H A -> Prop) : Prop :=
    ~ (F (bot A))
    /\
    F (top A)
    /\
    (forall a b, F a -> F b -> F (meet a b))
    /\
    (forall a b, F a -> R a b -> F b).

  Variable interp : var -> H A.

  Definition KripkeModelOfHeytingAlgebra : KripkeModel.
  Defined.

  Hypothesis xm : forall X:Prop, X \/ ~ X.

  Lemma evalH_evalK_agree s :
    forall F: H A -> Prop, forall FF: ProperFilter F,
      @evalK KripkeModelOfHeytingAlgebra s (exist ProperFilter F FF) <->
      F (@evalH A interp s).

End HeytingAlgebraToKripkeModel.