(* File: Kripke_Trees.v  (last edited on 25/10/2000) (c) Klaus Weich  *)
Require Export AvlTrees.
Require Export Trees.
Require Export Derivations.
(*******   Kripke_Model    ****************************************)
Inductive Kripke_Model (A : Set) (World : A -> Type)
(le : A -> A -> Type) (forces0 : A -> Int -> Prop) : Type :=
kripke_model :
(forall k : A, World k -> le k k) ->
(forall k0 k1 k2 : A,
World k0 -> World k1 -> World k2 -> le k0 k1 -> le k1 k2 -> le k0 k2) ->
(forall k0 k1 : A,
World k0 ->
World k1 -> le k0 k1 -> forall i : Int, forces0 k0 i -> forces0 k1 i) ->
Kripke_Model A World le forces0.
Fixpoint forces (A : Set) (World : A -> Type)
(le : A -> A -> Type) (forces0 : A -> Int -> Prop)
(k : A) (a : form) {struct a} : Prop :=
match a with
| Falsum => False
| Atom i => forces0 k i
| AndF a0 a1 =>
forces A World le forces0 k a0 /\ forces A World le forces0 k a1
| OrF a0 a1 =>
forces A World le forces0 k a0 \/ forces A World le forces0 k a1
| Imp a0 a1 =>
forall k' : A,
World k' ->
le k k' ->
forces A World le forces0 k' a0 -> forces A World le forces0 k' a1
end.
intros A World le forces0 kripke k a w; elim a; clear a.
simpl in |- *.
trivial.
intros.
elim kripke.
intros refl trans mon.
simpl in |- *; apply (mon k k'); assumption.
intros a ih_a b ih_b.
simpl in |- *.
intros u0; elim u0; clear u0; intros u0 u1.
intros; split.
apply ih_a; assumption.
apply ih_b; assumption.
intros a ih_a b ih_b.
simpl in |- *.
intros u0; elim u0; clear u0; intros u0.
intros; left.
apply ih_a; assumption.
intros; right.
apply ih_b; assumption.
intros a ih_a b ih_b.
simpl in |- *.
intros.
apply H.
assumption.
elim kripke.
intros refl trans mon.
apply (trans k k' k'0); assumption.
assumption.
Qed.
intros t context a der_t A World le forces0 kripke_model0.
elim der_t; clear der_t t a context.
(* t=(Var n) *)
intros context n a nth k world forces_context.
apply forces_context.
apply nth_in with n; assumption.
(* t=(Efq r b) *)
intros context r a der_t ih k world forces_context.
elimtype False.
apply (ih k world forces_context).
(* t=(Abs a0 r) *)
intros context a r b der_t ih k world forces_context.
simpl in |- *.
intros k' world_k' le_k' forces_a0.
apply (ih k' world_k').
intros c in_c.
inversion_clear in_c.
rewrite <- H.
assumption.
apply forces_mon with k; try assumption.
apply forces_context; assumption.
(* t=(App r s) *)
intros context r s a b der_r ih_r der_s ih_s k world forces_context.
apply (ih_r k world forces_context k).
assumption.
elim kripke_model0; auto.
apply (ih_s k world forces_context).
(* t=(Pair r s) *)
intros context r s a b der_r ih_r der_s ih_s k world forces_context.
split.
apply (ih_r k world forces_context).
apply (ih_s k world forces_context).
(* t=(PrL r) *)
intros context r a b der_r ih k world forces_context.
generalize (ih k world forces_context).
intros u0; elim u0; intros; assumption.
(* t=(PrR r) *)
intros context r a b der_r ih k world forces_context.
generalize (ih k world forces_context).
intros u0; elim u0; intros; assumption.
(* t=(OrFL r b) *)
intros context r a b der_r ih k world forces_context.
left.
apply (ih k world forces_context).
(* t=(OrFR r b) *)
intros context r a b der_r ih k world forces_context.
right.
apply ih; assumption.
(* t=(Cas r s t) *)
intros context r s t a b c der_r ih_r der_s ih_s der_t ih_t k world
forces_context.
generalize (ih_r k world forces_context); clear ih_r.
intro u0; elim u0; clear u0.
intro forces_a0.
apply ih_s; clear ih_s ih_t.
assumption.
intros c0 in_c0.
inversion_clear in_c0.
rewrite <- H; assumption.
apply forces_context; assumption.
intros forces_b.
apply ih_t; clear ih_s ih_t.
assumption.
intros c0 in_c0; inversion_clear in_c0.
rewrite <- H; assumption.
apply forces_context; assumption.
(* t=(Shift r) *)
intros context r a b der_r ih k world forces_context.
apply ih.
assumption.
intros c in_c.
apply forces_context.
right; assumption.
Qed.
intros A World le forces0 kripke k w b forces_b.
intros a.
simpl in |- *.
intros k' w' le_k_k' forces_a.
apply forces_mon with (k := k); assumption.
Qed.
intros A World le forces0 kripke k world a0 a1 b forces_a0_a1_b.
simpl in |- *.
intros k' u0 u1 forces_a0_and_a1.
elim forces_a0_and_a1; clear forces_a0_and_a1.
intros forces_a0 forces_a1.
apply (forces_a0_a1_b k' u0 u1).
apply forces_a0.
apply u0.
elim kripke.
intros refl trans mon.
apply refl.
apply u0.
apply forces_a1.
Qed.
intros A World le forces0 k a0 a1 c b forces_a0_c forces_a1_c forces_c_b.
simpl in |- *.
intros k' u0 u1 forces_a0_or_a1.
elim forces_a0_or_a1; clear forces_a0_or_a1.
intro forces_a0.
apply (forces_c_b k' u0 u1).
apply (forces_a0_c k' u0 u1 forces_a0).
intro forces_a1.
apply (forces_c_b k' u0 u1).
apply (forces_a1_c k' u0 u1 forces_a1).
Qed.
intros A World le forces0 k a0 a1 b forces_a0_b forces_a1_b.
simpl in |- *.
intros k' u0 u1 forces_a0_or_a1.
elim forces_a0_or_a1; clear forces_a0_or_a1.
intro forces_a0.
apply (forces_a0_b k' u0 u1 forces_a0).
intro forces_a1.
apply (forces_a1_b k' u0 u1 forces_a1).
Qed.
intros A World le forces0 kripke k w a0 forces_a0 a1 b forces_a1_b.
simpl in |- *.
intros k' w' le_k_k' forces_a0_a1.
apply (forces_a1_b k').
assumption.
assumption.
change (forces A World le forces0 k' a1) in |- *.
apply (forces_a0_a1 k').
assumption.
elim kripke.
intros refl trans mon.
apply refl.
assumption.
apply forces_mon with (k := k); assumption.
Qed.
intros A World le forces0 kripke k w a0 forces_a0 a1 b forces_a0a1_b.
simpl in |- *.
intros k' w' le_k_k' forces_a1.
apply (forces_a0a1_b k').
assumption.
assumption.
change (forces A World le forces0 k' (Imp a0 a1)) in |- *.
simpl in |- *.
intros k'' w'' le'' forces_a0''.
elim kripke.
intros refl trans mon.
apply forces_mon with (k := k'); assumption.
Qed.
intros A World le forces0 k a0 b forces_a0_b a1.
simpl in |- *.
intros k' w' le_k_k' forces_a0_a1.
apply (forces_a0_b k').
assumption.
assumption.
change (forces A World le forces0 k' a0) in |- *.
elim forces_a0_a1; trivial.
Qed.
intros A World le forces0 k a1 b forces_a1_b a0.
simpl in |- *.
intros k' w' le_k_k' forces_a0_a1.
apply (forces_a1_b k').
assumption.
assumption.
change (forces A World le forces0 k' a1) in |- *.
elim forces_a0_a1; trivial.
Qed.
(*******   kripke_trees    ****************************************)
Definition atoms := AVL unit.
Definition ANil := AVL_NIL unit.
Definition kripke_tree := Tree atoms.
Definition Kripke_Forest := Forest atoms.
Definition forces0_t (A : atoms) (i : Int) := LOOKUP unit i A tt.
Definition Is_Monotone_kripke_tree := Is_Monotone_Tree atoms Int forces0_t.
Definition Is_Monotone_Kripke_Forest :=
Is_Monotone_Forest atoms Int forces0_t.
Definition Suc (k0 k1 : kripke_tree) := Successor atoms k0 k1.
Definition Atms (k : kripke_tree) := root atoms k.
Definition Succs (k0 : kripke_tree) := successors atoms k0.

Lemma kripke_tree_kripke_model :
forall k : kripke_tree,
Is_Monotone_kripke_tree k ->
Kripke_Model kripke_tree (fun k0 : kripke_tree => Suc k0 k)
(fun k0 k1 : kripke_tree => Suc k1 k0)
(fun (k0 : kripke_tree) (i : Int) => forces0_t (Atms k0) i).